📄 frmbuildingfind.frm
字号:
VERSION 5.00
Begin VB.Form Frmbuildingfind
BackColor = &H00C0FFFF&
Caption = "楼盘查询"
ClientHeight = 7590
ClientLeft = 60
ClientTop = 450
ClientWidth = 9675
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 7590
ScaleWidth = 9675
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdprint
Caption = "打印"
Height = 375
Left = 8520
TabIndex = 17
Top = 1560
Width = 855
End
Begin VB.PictureBox gridloupan
BackColor = &H00FFFFFF&
Height = 4935
Left = 360
ScaleHeight = 4875
ScaleWidth = 8955
TabIndex = 16
Top = 2280
Width = 9015
End
Begin VB.CommandButton cmdexit
Caption = "退出"
Height = 375
Left = 8520
TabIndex = 2
Top = 960
Width = 855
End
Begin VB.CommandButton cmdfind
Caption = "查询"
Height = 375
Left = 8520
TabIndex = 1
Top = 360
Width = 855
End
Begin VB.Frame Frame1
BackColor = &H00C0FFFF&
Caption = "查询条件"
Height = 1815
Left = 360
TabIndex = 0
Top = 240
Width = 8055
Begin VB.PictureBox Printgrid1
Height = 480
Left = 6840
ScaleHeight = 420
ScaleWidth = 1140
TabIndex = 18
Top = 1560
Width = 1200
End
Begin VB.TextBox txtpri2
Height = 375
Left = 2880
TabIndex = 13
Top = 1080
Width = 855
End
Begin VB.TextBox txtpri1
Height = 375
Left = 1440
TabIndex = 12
Top = 1080
Width = 855
End
Begin VB.TextBox txtlouceng
Height = 375
Left = 6120
TabIndex = 11
Top = 240
Width = 855
End
Begin VB.TextBox txtlouhao
Height = 375
Left = 3840
TabIndex = 10
Top = 240
Width = 855
End
Begin VB.TextBox txtnum
Height = 405
Left = 1440
TabIndex = 9
Top = 240
Width = 1215
End
Begin VB.ComboBox Combo1
Height = 315
Left = 6120
TabIndex = 8
Text = "选择户型"
Top = 1080
Width = 1335
End
Begin VB.OptionButton Optionhuxing
BackColor = &H00C0FFFF&
Caption = "户型"
Height = 255
Left = 5400
TabIndex = 7
Top = 1080
Width = 735
End
Begin VB.OptionButton Optionpri
BackColor = &H00C0FFFF&
Caption = "单位报价"
Height = 255
Left = 360
TabIndex = 6
Top = 1200
Width = 1215
End
Begin VB.OptionButton Optionlouceng
BackColor = &H00C0FFFF&
Caption = "楼层"
Height = 255
Left = 5400
TabIndex = 5
Top = 360
Width = 1335
End
Begin VB.OptionButton Optionlouhao
BackColor = &H00C0FFFF&
Caption = "楼号"
Height = 255
Left = 3120
TabIndex = 4
Top = 360
Width = 735
End
Begin VB.OptionButton Optionnum
BackColor = &H00C0FFFF&
Caption = "楼盘编号"
Height = 375
Left = 360
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "-------"
Height = 195
Left = 2280
TabIndex = 15
Top = 1200
Width = 315
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "元/平方米"
Height = 195
Left = 3840
TabIndex = 14
Top = 1200
Width = 795
End
End
End
Attribute VB_Name = "Frmbuildingfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_huxing As New ADODB.Recordset '户型
Dim rs_loupan As New ADODB.Recordset '楼盘
Private Sub cmdfind_Click()
Dim sql As String
On Error GoTo loaderror
gridloupan.Clear
If Optionnum.Value = True Then
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price, " & _
"户型.Hst_ID,户型.Hst_buildarea,户型.Hst_usearea,户型.Hst_type, " & _
"户型.Hst_memo,户型.Hst_picture from 楼盘,户型 where 楼盘.hos_hstid = 户型.Hst_ID " & _
" and 楼盘.hos_id = '" & txtnum.Text & "'"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
End If
'按照楼号查询
If Optionlouhao.Value = True Then
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price, " & _
"户型.Hst_ID,户型.Hst_buildarea,户型.Hst_usearea,户型.Hst_type, " & _
"户型.Hst_memo,户型.Hst_picture from 楼盘,户型 where 楼盘.hos_hstid = 户型.Hst_ID " & _
" and 楼盘.hos_id like '" & Trim(txtlouhao.Text) & "%'"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
End If
'按照楼层查询
If Optionlouceng.Value = True Then
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price, " & _
"户型.Hst_ID,户型.Hst_buildarea,户型.Hst_usearea,户型.Hst_type, " & _
"户型.Hst_memo,户型.Hst_picture from 楼盘,户型 where 楼盘.hos_hstid = 户型.Hst_ID " & _
" and 楼盘.hos_id like '????" & Trim(txtlouceng.Text) & "??'"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
End If
'按照单位报价查询
If Optionpri.Value = True Then
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price, " & _
"户型.Hst_ID,户型.Hst_buildarea,户型.Hst_usearea,户型.Hst_type, " & _
"户型.Hst_memo,户型.Hst_picture from 楼盘,户型 where 楼盘.hos_hstid = 户型.Hst_ID " & _
" and 楼盘.hos_price between " & CCur(Trim(txtpri1.Text)) & " and " & CCur(Trim(txtpri2.Text))
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
End If
'按照户型查询
If Optionhuxing.Value = True Then
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price, " & _
"户型.Hst_ID,户型.Hst_buildarea,户型.Hst_usearea,户型.Hst_type, " & _
"户型.Hst_memo,户型.Hst_picture from 楼盘,户型 where 楼盘.hos_hstid = 户型.Hst_ID " & _
" and 户型.Hst_type = '" & Combo1.Text & "'"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
End If
Exit Sub
loaderror:
MsgBox Err.Description
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdprint_Click()
Printgrid1.Unit = Centimeter
Printgrid1.PrintObject = gridloupan
Printgrid1.DoPreView
End Sub
Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select 楼盘.hos_id,楼盘.hos_hstid,楼盘.hos_price,户型.Hst_ID,户型.Hst_buildarea," & _
"户型.Hst_usearea,户型.Hst_type,户型.Hst_memo,户型.Hst_picture from 楼盘,户型 " & _
"where 楼盘.hos_hstid = 户型.Hst_ID"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic '打开数据库
Combo1.AddItem "二室二厅"
Combo1.AddItem "一室二厅"
Combo1.AddItem "一室二厅"
Combo1.AddItem "复 式"
Combo1.AddItem "三室二厅"
setgrid
setgridhead
displaygrid
rs_loupan.Close
Exit Sub
loaderror:
MsgBox Err.Description
End Sub
Public Sub displaygrid()
Dim i As Integer
On Error GoTo displayerror
gridloupan.Row = 0
If Not rs_loupan.EOF Then
rs_loupan.MoveFirst
Do While Not rs_loupan.EOF
gridloupan.Row = gridloupan.Row + 1
gridloupan.Col = 0
If Not IsNull(rs_loupan.Fields(0)) Then gridloupan.Text = rs_loupan.Fields(0) _
Else gridloupan.Text = ""
gridloupan.Col = 1
If Not IsNull(rs_loupan.Fields(4)) Then gridloupan.Text = rs_loupan.Fields(4) _
Else gridloupan.Text = ""
gridloupan.Col = 2
If Not IsNull(rs_loupan.Fields(5)) Then gridloupan.Text = rs_loupan.Fields(5) _
Else gridloupan.Text = ""
gridloupan.Col = 3
gridloupan.Text = CStr(rs_loupan.Fields(4) - rs_loupan.Fields(5))
gridloupan.Col = 4
If Not IsNull(rs_loupan.Fields(6)) Then gridloupan.Text = rs_loupan.Fields(6) _
Else gridloupan.Text = ""
gridloupan.Col = 5
If Not IsNull(rs_loupan.Fields(2)) Then gridloupan.Text = rs_loupan.Fields(2) _
Else gridloupan.Text = ""
gridloupan.Col = 6
gridloupan.Text = CStr(rs_loupan.Fields(2) * rs_loupan.Fields(4))
rs_loupan.MoveNext
Loop
End If
displayerror:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Public Sub setgrid()
Dim i As Integer
On Error GoTo seterror
With gridloupan
.ScrollBars = flexScrollBarBoth
.FixedCols = 1
.Rows = rs_loupan.RecordCount + 1
.Cols = 7
.SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
.RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
.ColWidth(i) = 1300
Next i
End With
Exit Sub
seterror:
MsgBox Err.Description
End Sub
Public Sub setgridhead()
On Error GoTo setheaderror
gridloupan.Row = 0
gridloupan.Col = 0
gridloupan.Text = "楼盘编号"
gridloupan.Col = 1
gridloupan.Text = "建筑面积"
gridloupan.Col = 2
gridloupan.Text = "套内面积"
gridloupan.Col = 3
gridloupan.Text = "分摊面积"
gridloupan.Col = 4
gridloupan.Text = "户型"
gridloupan.Col = 5
gridloupan.Text = "单位报价"
gridloupan.Col = 6
gridloupan.Text = "楼盘报价"
Exit Sub
setheaderror:
MsgBox Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -