📄 frmsqlsearch.frm
字号:
VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSQLSearch
BorderStyle = 1 'Fixed Single
Caption = "搜索属性"
ClientHeight = 5700
ClientLeft = 45
ClientTop = 330
ClientWidth = 8430
Icon = "frmSQLSearch.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5700
ScaleWidth = 8430
StartUpPosition = 1 '所有者中心
Begin VB.Frame fraExpression
Caption = "条件表达式"
Height = 1575
Left = 2520
TabIndex = 9
Top = 4080
Width = 5895
Begin VB.TextBox txtSearch
Height = 1215
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 10
Top = 240
Width = 5655
End
End
Begin VB.Frame fraField
Caption = "字段"
Height = 5175
Left = 0
TabIndex = 2
Top = 480
Width = 2415
Begin MSComctlLib.ListView lstField
Height = 4455
Left = 120
TabIndex = 17
Top = 600
Width = 2175
_ExtentX = 3836
_ExtentY = 7858
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
HideColumnHeaders= -1 'True
Checkboxes = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Object.Width = 3819
EndProperty
End
Begin VB.Label Label1
Caption = "请选择需要显示的字段名"
Height = 375
Left = 120
TabIndex = 3
Top = 360
Width = 2175
End
End
Begin VB.Frame fraSQL
Caption = "生成条件"
Height = 3495
Left = 2520
TabIndex = 1
Top = 480
Width = 5895
Begin VB.TextBox txtValue
Height = 270
Left = 3720
TabIndex = 16
Top = 480
Width = 1935
End
Begin VB.TextBox txtField
Height = 270
Left = 240
TabIndex = 15
Top = 480
Width = 1935
End
Begin VB.ListBox lstExistValue
Height = 2040
Left = 3720
TabIndex = 14
Top = 840
Width = 1935
End
Begin VB.ListBox lstSelectField
Height = 2040
Left = 240
TabIndex = 13
Top = 840
Width = 1935
End
Begin VB.ComboBox cmbRelate
Height = 300
ItemData = "frmSQLSearch.frx":08A6
Left = 1800
List = "frmSQLSearch.frx":08B6
TabIndex = 12
Text = "AND"
Top = 3000
Width = 1575
End
Begin VB.CommandButton cmbAdd
Caption = "加入"
Height = 255
Left = 4920
TabIndex = 8
Top = 3000
Width = 735
End
Begin VB.ComboBox cmbOperate
Height = 300
ItemData = "frmSQLSearch.frx":08D4
Left = 2280
List = "frmSQLSearch.frx":08ED
TabIndex = 6
Text = "等于"
Top = 480
Width = 1335
End
Begin VB.Label Label6
Caption = "与其他条件关系:"
Height = 255
Left = 240
TabIndex = 11
Top = 3120
Width = 1455
End
Begin VB.Label Label5
Caption = "值:"
Height = 255
Left = 3720
TabIndex = 7
Top = 240
Width = 615
End
Begin VB.Label Label4
Caption = "条件:"
Height = 255
Left = 2280
TabIndex = 5
Top = 240
Width = 855
End
Begin VB.Label Label3
Caption = "字段名:"
Height = 255
Left = 240
TabIndex = 4
Top = 240
Width = 735
End
End
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Align = 1 'Align Top
Height = 495
Left = 0
TabIndex = 0
Top = 0
Width = 8430
_LayoutVersion = 1
_ExtentX = 14870
_ExtentY = 873
_DataPath = ""
Bands = "frmSQLSearch.frx":0925
End
End
Attribute VB_Name = "frmSQLSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------------
'2002-11-11改进初始化，清除残留数据
'2002-10-25将treeview改成ListView,用mo.strings修改ExistValue
'2002-10-15
'重写所有模块.
'加入数据参考（相关字段已存在值）功能
'修正数据查询语句生成函数。解决各种类型数据查询问题
'----------------------------------------------------------------------------------
Dim Index As Long
Public Sub InitForm(lIndex As Long)
'------------------------------------------------
'对窗体和各个控件初始化
'------------------------------------------------
Index = lIndex
Call IniRelate
Call IniOperator
Call InilstField
txtValue = ""
txtField = ""
txtSearch = ""
End Sub
Private Sub InilstField()
'------------------------------------------------
'刷新lstField
'------------------------------------------------
Dim RecordX As MapObjects2.Recordset
Dim ListX As ListItem
Set RecordX = frmMain.Map1.Layers(Index).Records
lstField.ListItems.Clear
lstSelectField.Clear
Dim lpointer As Long
lstField.ListItems.Clear
For lpointer = 0 To RecordX.TableDesc.FieldCount - 1
If Not bIsExcept(RecordX.TableDesc.FieldName(lpointer) _
, Index) Then
Set ListX = lstField.ListItems.Add( _
Key:=RecordX.TableDesc.FieldName(lpointer), _
text:=RecordX.TableDesc.FieldName(lpointer))
ListX.Checked = True
lstSelectField.AddItem RecordX.TableDesc.FieldName(lpointer)
End If
Next lpointer
End Sub
Private Sub IniOperator()
'-----------------------------------------------
'刷新运算符
'-----------------------------------------------
cmbOperate.AddItem "="
cmbOperate.AddItem ">"
cmbOperate.AddItem ">="
cmbOperate.AddItem "<"
cmbOperate.AddItem "<="
cmbOperate.AddItem "<>"
cmbOperate.AddItem "包含"
cmbOperate.ListIndex = 0
End Sub
Private Sub IniRelate()
'-----------------------------------------------
'刷新关系
'-----------------------------------------------
cmbRelate.Clear
cmbRelate.AddItem "and"
cmbRelate.AddItem "or"
cmbRelate.AddItem "and not"
cmbRelate.AddItem "or not"
cmbRelate.ListIndex = 0
End Sub
Private Sub RefreshExistValue()
'------------------------------------------------
'调集数据的数据库中已有数据作为参考
'------------------------------------------------
lstExistValue.Clear
If lstSelectField.ListIndex < 0 Then
Exit Sub
End If
RecQuery.MoveFirst
If RecQuery.EOF Then Exit Sub
Dim strField As String
strField = lstSelectField.List(lstSelectField.ListIndex)
Dim ExistValue As New MapObjects2.Strings
Do Until RecQuery.EOF
ExistValue.Add RecQuery.Fields(strField).ValueAsString
RecQuery.MoveNext
If ExistValue.Count2 > 200 Then Exit Do
DoEvents
Loop
Dim lpointer As Long
For lpointer = 0 To ExistValue.Count2 - 1
lstExistValue.AddItem ExistValue(lpointer)
DoEvents
Next lpointer
End Sub
Private Function fnStructQuery() As String
'-----------------------------------------------
'根据用户输入，构造查询语句
'-----------------------------------------------
Dim strOperate As String
Dim strValue As String
strValue = txtValue
If cmbOperate = "包含" Then
strOperate = "like"
strValue = "%" & strValue & "%"
Else
strOperate = cmbOperate
End If
'判断字段类型,若字段为非数值字段,则自动添加双引号
Select Case fnFieldType(txtField)
Case -1
strValue = "'" & strValue & "'"
Case moLong
strValue = strValue
Case moDouble
strValue = strValue
Case moDate
strValue = strValue
Case moString
strValue = "'" & strValue & "'"
Case Else
strValue = "'" & strValue & "'"
End Select
fnStructQuery = txtField & " " & strOperate & " " & strValue
End Function
Private Function fnFieldType(strField As String) _
As FieldTypeConstants
'---------------------------------------------------
'已知字段名strField查询其类型
'---------------------------------------------------
Dim lpField As Long
'查找字段
For lpField = 0 To RecQuery.TableDesc.FieldCount - 1
If RecQuery.TableDesc.FieldName(lpField) = strField Then Exit For
Next
If lpField > RecQuery.TableDesc.FieldCount - 1 Then
fnFieldType = -1 '没找到字段
Else
fnFieldType = RecQuery.TableDesc.FieldType(lpField)
End If
End Function
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
Case "Search"
g_searchExpression = txtSearch.text
Me.Hide
Call GetDataset(Index, byExpression)
Call frmTrackSearch.InitForm(Index)
If Not frmTrackSearch.Visible Then
frmTrackSearch.Show
End If
Case "Exit"
Me.Hide
Case "Clean"
txtSearch.text = ""
End Select
End Sub
Private Sub cmbAdd_Click()
'---------------------------------------------------
'用户单击"添加"按钮,将当前用户输入的条件添加到搜索条件中
'---------------------------------------------------
If txtField <> "" And txtValue <> "" Then
If Trim(txtSearch) <> "" Then
txtSearch = txtSearch & " " & cmbRelate & " " & fnStructQuery
Else
txtSearch = fnStructQuery
End If
End If
End Sub
Private Sub lstExistValue_Click()
'---------------------------------------------------
'用户单击参考列表,将参考列表中用户选择数据更新至控件
'---------------------------------------------------
If lstExistValue.ListIndex >= 0 Then
txtValue = lstExistValue.List(lstExistValue.ListIndex)
End If
End Sub
Private Sub lstSelectField_Click()
'---------------------------------------------------
'用户单击字段列表,将字段列表中用户选择字段更新至控件
'---------------------------------------------------
If lstSelectField.ListIndex >= 0 Then
txtField = lstSelectField.List(lstSelectField.ListIndex)
Call RefreshExistValue
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -