📄 frmquery.frm
字号:
Width = 10470
_ExtentX = 18468
_ExtentY = 1058
Enabled = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaskColor = -2147483633
Style = 1
End
Begin VB.Frame fraQuery2
Caption = "已定义的查询条件"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4935
Left = 5325
TabIndex = 17
Top = 780
Width = 5145
Begin VB.ComboBox cmbCondition
Height = 300
ItemData = "FrmQuery.frx":2186
Left = 2715
List = "FrmQuery.frx":2190
Style = 2 'Dropdown List
TabIndex = 20
Top = 2580
Visible = 0 'False
Width = 1095
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MfgQuery
Height = 4635
Left = 45
TabIndex = 19
Top = 240
Width = 5040
_ExtentX = 8890
_ExtentY = 8176
_Version = 393216
BackColor = -2147483628
Rows = 6
Cols = 4
BackColorFixed = -2147483624
BackColorSel = 16752029
ForeColorSel = -2147483625
BackColorBkg = -2147483628
WordWrap = -1 'True
AllowBigSelection= 0 'False
AllowUserResizing= 3
RowSizingMode = 1
BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 4
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
End
End
End
Attribute VB_Name = "FrmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private cnDB As New ADODB.Connection
Private rs As New ADODB.Recordset
Public QuerySQL As String '窗体显示时打开的表的SQL语句
Private gRow As Integer '记录MfgQuery中选中的行码
Private gCol As Integer '记录MfgQuery中选中的列码
Private gCondition As Integer '记录条件数，最多为5个条件
Private Sub cmbCondition_LostFocus() '条件连接符
MfgQuery.TextMatrix(gRow, gCol) = Me.cmbCondition.Text
cmbCondition.Visible = False
End Sub
Private Sub cmdAdd_Click() '增加查询条件
Select Case LisFields.ItemData(LisFields.ListIndex) 'LisFields中选中字段的类型
Case 200, 201, 202, 203, 129, 130 ' 字段类型为字符型
If Trim(Me.cmbValue.Text) <> "" Then '如果字段值不为空
gCondition = gCondition + 1
If Me.cmbOperator <> "Like" Then '如果运算符不为Like
If Me.cmbValue.Text = "(空值)" Then '如果选中的值为空值
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = "IS Null"
Else '如果选中的值为不空值
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = Me.cmbOperator & " '" & StrToSQL(Me.cmbValue) & "' "
End If
Else '如果运算符为Like
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = Me.cmbOperator & " '" & StrToSQL(Me.cmbValue) & "%' "
End If
Else '如果字段值为空
MsgBox "请在下拉列表中选取一项或填入要查询的值！", vbCritical + vbOKOnly, "提示"
Me.cmbValue.SetFocus
Exit Sub
End If
Case 2, 3, 4, 5, 6, 11, 131 '字段类型为数值型
If Trim(Me.cmbValue.Text) <> "" And IsNumeric(Me.cmbValue.Text) Then
gCondition = gCondition + 1
If Me.cmbOperator <> "Like" Then
If Me.cmbValue.Text = "(空值)" Then
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = "IS Null"
Else
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = Me.cmbOperator & " " & Me.cmbValue & " "
End If
Else
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text & " "
MfgQuery.TextMatrix(gCondition, 2) = Me.cmbOperator & " '" & Me.cmbValue & "%' "
End If
Else
If Trim(Me.cmbValue.Text) <> "" Then
MsgBox "输入的值格式有错误，请重新输入！", vbCritical + vbOKOnly, "提示"
Else
MsgBox "请在下拉列表中选取一项或填入要查询的值！", vbCritical + vbOKOnly, "提示"
End If
Me.cmbValue.SetFocus
Exit Sub
End If
Case 7 '字段类型为日期型
If Me.DtpFrom.Value <= Me.DTPTo.Value Then
gCondition = gCondition + 1
MfgQuery.TextMatrix(gCondition, 1) = Me.LisFields.Text
MfgQuery.TextMatrix(gCondition, 2) = " Between #" & Format(Me.DtpFrom.Value, "yyyy-MM-dd") & "# And #" & Format(Me.DTPTo.Value, "yyyy-MM-dd") & "#"
Else
MsgBox "终止日期小于起始日期！", vbCritical + vbOKOnly, "提示"
Me.DTPTo.SetFocus
Exit Sub
End If
End Select
If gCondition > 1 Then
Me.MfgQuery.TextMatrix(gCondition - 1, 3) = "And"
End If
Me.cmdYes.Enabled = True
Me.cmdRemove.Enabled = True
If gCondition = 5 Then
Me.cmdAdd.Enabled = False
End If
End Sub
Private Sub cmdRemove_Click() '移去最后一个查询条件
Dim I As Integer
For I = 1 To 3
Me.MfgQuery.TextMatrix(gCondition, I) = ""
Next
If gCondition - 1 > 0 Then
Me.MfgQuery.TextMatrix(gCondition - 1, 3) = ""
End If
Me.cmdAdd.Enabled = True
gCondition = gCondition - 1
If gCondition = 0 Then
Me.cmdRemove.Enabled = False
Me.cmdYes.Enabled = False
End If
End Sub
Private Sub cmdYes_Click() '生成查询条件语句
Dim I As Integer
Dim mSQL As String
gQuerySQL = ""
mSQL = ""
For I = 1 To Me.MfgQuery.Rows - 1
If Trim(Me.MfgQuery.TextMatrix(I, 1)) <> "" Then '如果查询条件中的字段名称不为空
mSQL = Me.MfgQuery.TextMatrix(I, 1) & " " & Me.MfgQuery.TextMatrix(I, 2)
Select Case I
Case 1
gQuerySQL = gQuerySQL & mSQL
Case Else
gQuerySQL = gQuerySQL & " " & Me.MfgQuery.TextMatrix(I - 1, 3) & " " & mSQL
End Select
Else '如果查询条件中的字段名称为空
Exit For '退出循环
End If
Next
If Trim(gQuerySQL) <> "" Then
gQuerySQL = "Where " & gQuerySQL
Else
gQuerySQL = ""
End If
Unload Me
End Sub
Private Sub Form_Load()
Dim I As Integer
gQuerySQL = ""
'cnDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & gDBPath & ";Jet OLEDB:Database Password=czlxming;Persist Security Info=False"
'cnDB.ConnectionString = "DSN=Warehouse"
cnDB.ConnectionString = gDSN
cnDB.CommandTimeout = 15
cnDB.Open
rs.Open QuerySQL, cnDB, adOpenStatic, adLockReadOnly
For I = 0 To rs.Fields.Count - 1
LisFields.AddItem rs.Fields(I).Name
LisFields.ItemData(LisFields.NewIndex) = rs.Fields(I).Type
Next
gCondition = 0
'----------- 格式化mfgQuery -------
MfgQuery.TextMatrix(0, 0) = "条件"
MfgQuery.TextMatrix(0, 1) = "字段名称"
MfgQuery.TextMatrix(0, 2) = "查询值"
MfgQuery.TextMatrix(0, 3) = "连接条件"
MfgQuery.ColWidth(0) = 260
MfgQuery.ColWidth(1) = 1515
MfgQuery.ColWidth(2) = 2250
MfgQuery.ColWidth(3) = 930
MfgQuery.RowHeight(0) = 800
For I = 1 To MfgQuery.Rows - 1
MfgQuery.TextMatrix(I, 0) = I
MfgQuery.RowHeight(I) = 750
Next
End Sub
Private Sub cmdNo_Click()
gQuerySQL = ""
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
rs.Close
cnDB.Close
Set cnDB = Nothing
End Sub
Private Sub LisFields_Click() '选中字段列表框
If LisFields.ItemData(LisFields.ListIndex) <> "135" Then '如果选中的字段不是日期类型
fraValue1.Visible = True
fraValue1.Enabled = True
fraValue2.Visible = False
Me.cmbOperator.ListIndex = 0
cmbValue.Clear
cmbValue.AddItem "(空值)"
If Not rs.EOF Or Not rs.BOF Then
rs.MoveFirst
Do While Not rs.EOF '列出选中字段的可能值
cmbValue.AddItem rs.Fields(LisFields.ListIndex)
rs.MoveNext
Loop
End If
Else '如果选中的字段是日期类型
fraValue2.Visible = True
fraValue1.Visible = False
Me.DtpFrom.Value = Format(Now, "yyyy-MM-dd")
Me.DTPTo.Value = Format(Now, "yyyy-MM-dd")
End If
If gCondition < 5 Then
Me.cmdAdd.Enabled = True
End If
End Sub
Private Sub MSHFlexGridEdit(MSHFlexGrid As Control, Cmb As Control) '在MfgQuery选中的格上显示下拉选框
Cmb.Move MSHFlexGrid.Left + MSHFlexGrid.CellLeft - 10, _
MSHFlexGrid.Top + MSHFlexGrid.CellTop - 10, _
MSHFlexGrid.CellWidth
Cmb.Visible = True
Cmb.ListIndex = 0
MSHFlexGrid.TextMatrix(gRow, gCol) = ""
Cmb.SetFocus
End Sub
Private Sub MfgQuery_Click() '选中mfgQuery
gRow = MfgQuery.row
gCol = MfgQuery.Col
If MfgQuery.Col = 3 Then
If Trim(MfgQuery.TextMatrix(gRow, 1)) <> "" And MfgQuery.row <> 5 Then '当选中的列为第四列并且不是最后一行时
MSHFlexGridEdit MfgQuery, Me.cmbCondition '显示下拉选框
End If
End If
End Sub
Private Sub MfgQuery_KeyPress(KeyAscii As Integer)
gRow = MfgQuery.row
gCol = MfgQuery.Col
If MfgQuery.Col = 3 Then
If Trim(MfgQuery.TextMatrix(gRow, 1)) <> "" And MfgQuery.row <> 5 Then '当选中的列为第四列并且不是最后一行时
MSHFlexGridEdit MfgQuery, Me.cmbCondition '显示下拉选框
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -