📄 frmquery.frm
字号:
Height = 270
Left = 2490
TabIndex = 23
Top = 240
Width = 1215
End
Begin VB.Label Label5
Caption = "字段名称："
Height = 270
Left = 315
TabIndex = 22
Top = 240
Width = 1215
End
End
Begin MSComctlLib.ListView lvwFieldName
Height = 4590
Left = 120
TabIndex = 1
Top = 840
Width = 3300
_ExtentX = 5821
_ExtentY = 8096
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
Checkboxes = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin MSFlexGridLib.MSFlexGrid msfResult
Height = 6345
Left = -74880
TabIndex = 15
Top = 480
Visible = 0 'False
Width = 10065
_ExtentX = 17754
_ExtentY = 11192
_Version = 393216
FixedCols = 0
FocusRect = 0
SelectionMode = 2
AllowUserResizing= 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ListBox lstFindName
DataField = "f"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5100
Left = 120
TabIndex = 0
Top = 840
Visible = 0 'False
Width = 1935
End
Begin VB.Label Label4
Caption = "查询条件设置："
Height = 270
Left = 4725
TabIndex = 21
Top = 585
Width = 1905
End
Begin VB.Label Label3
Caption = "要显示的字段："
Height = 270
Left = 180
TabIndex = 20
Top = 585
Width = 1710
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "生成单据的年份"
Height = 180
Index = 1
Left = -70980
TabIndex = 16
Top = 1545
Width = 1260
End
Begin VB.Label Label2
Caption = "查询种类："
Height = 270
Left = 180
TabIndex = 19
Top = 585
Visible = 0 'False
Width = 1215
End
End
Begin MSComDlg.CommonDialog cdlFile
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "导出Excel文件|*.xls"
End
End
Attribute VB_Name = "frmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strOri As String '源查询'''''
Dim bInFill As Boolean
Dim isCancel As Boolean
Dim bCode As Boolean
Private strSqlCondition As String
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Public Property Let SQLCondition(ByVal strValue As String)
strSqlCondition = strValue
End Property
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
ST.Tab = 1
ST_Click (1)
End Sub
'ctrl+A 全选ctrl+D 全不选
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
If TypeOf Me.ActiveControl Is CommandButton Then
Call cmdAdd_Click
End If
End If
End Sub
Private Sub Form_Load()
On Error GoTo err_Handle
' frmmain.Skn.ApplySkin Me.hwnd
Me.Move (frmMain.ScaleWidth - Me.Width) / 2, (frmMain.ScaleHeight - Me.Height) / 3
ST.Tab = 0
' lvwFieldName.ColumnHeaders.Add , , "字段名称"
' lvwFieldName.ColumnHeaders.Add , , "排序顺序"
' ListTablesInDB gCnn, lstFindName, "B_"
' ListTablesInDB gCnn, lstFindName, gStlx
Call lstFindName_Click
txtCondition = strSqlCondition
err_Handle:
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
' gcnn.Execute "drop view " & strOri
On Error GoTo 0
End Sub
Private Sub Form_Resize()
ST.Top = 60
ST.Left = 60
ST.Width = Me.ScaleWidth - ST.Left * 2
ST.Height = Me.ScaleHeight - ST.Top - 60
msfResult.Left = 60
msfResult.Top = ST.TabHeight + 60
msfResult.Width = ST.Width - msfResult.Left * 2
msfResult.Height = ST.Height - msfResult.Top - 60
End Sub
Private Sub lstFindName_Click()
Me.strOri = gStlx 'gStlx & lstFindName.Text
lvwFieldName.CheckBoxes = True
'填字段
Me.FillFieldName
End Sub
Private Sub lvwFieldName_DblClick()
Dim Item As ListItem
' Dim pa As POINTAPI
' Dim x As Long
' Dim y As Long
' Dim lngResult As Long
Set Item = lvwFieldName.SelectedItem
If Item Is Nothing Then
Exit Sub
End If
Select Case Item.SubItems(1)
Case ""
Item.SubItems(1) = "升序"
Exit Sub
Case "升序"
Item.SubItems(1) = "降序"
Exit Sub
Case "降序"
Item.SubItems(1) = ""
Exit Sub
End Select
End Sub
Private Sub lvwFieldName_KeyPress(KeyAscii As Integer)
Dim Item As ListItem
If KeyAscii = vbKeyReturn Then
If lvwFieldName.SelectedItem Is Nothing Then
Exit Sub
Else
Set Item = lvwFieldName.SelectedItem
End If
Select Case Item.SubItems(1)
Case ""
Item.SubItems(1) = "升序"
Exit Sub
Case "升序"
Item.SubItems(1) = "降序"
Exit Sub
Case "降序"
Item.SubItems(1) = ""
Exit Sub
End Select
End If
End Sub
Sub FillFieldName()
'填写下拉列表框,网格列头
bInFill = True
Dim rstx As ADODB.Recordset
Dim iCnt As Integer
Dim ltm As ListItem
Set rstx = New ADODB.Recordset
rstx.Open "select top 1 * from " & strOri, gCnn, adOpenStatic, adLockReadOnly
lvwFieldName.ListItems.Clear
lvwFieldName.ColumnHeaders.Add , , "字段名称"
lvwFieldName.ColumnHeaders.Add , , "排序顺序"
msfResult.Rows = 1
msfResult.Cols = rstx.Fields.count
cmbField.Clear
For iCnt = 0 To rstx.Fields.count - 1
cmbField.AddItem rstx.Fields(iCnt).name
cmbField.ItemData(cmbField.ListCount - 1) = rstx.Fields(iCnt).Type
msfResult.Col = iCnt
msfResult.CellAlignment = flexAlignCenterCenter
msfResult.TextArray(iCnt) = rstx.Fields(iCnt).name
Select Case rstx.Fields(iCnt).Type
Case adDate, adDBDate, adDBTime, adDBTimeStamp
'居中对齐
msfResult.ColAlignment(iCnt) = flexAlignCenterCenter
Case adCurrency, adDecimal, adDouble, adInteger, adNumeric, adSingle, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt
'右对齐
msfResult.ColAlignment(iCnt) = flexAlignRightCenter
Case Else
msfResult.ColAlignment(iCnt) = flexAlignLeftCenter
End Select
Set ltm = lvwFieldName.ListItems.Add(, rstx.Fields(iCnt).name, rstx.Fields(iCnt).name)
ltm.SubItems(1) = ""
ltm.Checked = True
Next iCnt
rstx.Close
AdjustListViewWidth lvwFieldName
'Me.Refresh
'lvwFieldName.Refresh
End Sub
Private Sub cmbField_Click()
If cmbField.Text = "" Then
Exit Sub
End If
cmbValue.Clear
cmbCon.Clear
cmbCon.AddItem "="
cmbCon.AddItem ">"
cmbCon.AddItem "<"
cmbCon.AddItem ">="
cmbCon.AddItem "<="
cmbCon.AddItem "<>"
Select Case cmbField.ItemData(cmbField.ListIndex)
Case adChar, adLongVarBinary, adLongVarChar, adLongVarWChar, adVarChar, adVarWChar, adWChar
cmbCon.AddItem "like"
End Select
cmbCon.Text = "="
End Sub
Private Sub cmdAdd_Click()
Dim sMSG As String
Dim X As ADODB.DataTypeEnum
Dim gdateid As String
gdateid = "'"
'合法性判断
If cmbField = "" Then sMSG = sMSG & "字段 "
If cmbCon = "" Then sMSG = sMSG & "条件 "
If cmbValue = "" Then sMSG = sMSG & "值 "
If sMSG <> "" Then
MsgBox "请输入" & sMSG, vbInformation + vbOKOnly, "提示"
Exit Sub
End If
Dim scon As String
scon = " " & cmbField & " " & cmbCon & " "
Select Case cmbField.ItemData(cmbField.ListIndex)
Case adDate, adDBDate, adDBTime, adDBTimeStamp, adFileTime
If IsDate(cmbValue) Then
scon = scon & "" & gdateid & "" & CStr(CVDate(cmbValue)) & "" & gdateid & " "
Else
MsgBox "日期输入格式错误.", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
Case adChar, adLongVarBinary, adLongVarChar, adLongVarWChar, adVarChar, adVarWChar, adWChar
If cmbCon.Text = "like" Then
scon = scon & "'%" & cmbValue & "%' "
Else
scon = scon & "'" & cmbValue & "' "
End If
Case Else
scon = scon & cmbValue
End Select
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -