📄 form_log.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form Form_Log
Caption = "查询"
ClientHeight = 7425
ClientLeft = 645
ClientTop = 1110
ClientWidth = 10665
Icon = "Form_Log.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7425
ScaleWidth = 10665
Begin MSComctlLib.StatusBar Status
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 10
Top = 7050
Width = 10665
_ExtentX = 18812
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 18521
MinWidth = 18521
EndProperty
EndProperty
End
Begin MSFlexGridLib.MSFlexGrid Grid_Brow
Height = 3135
Left = 840
TabIndex = 7
Top = 3840
Width = 9015
_ExtentX = 15901
_ExtentY = 5530
_Version = 393216
AllowUserResizing= 1
End
Begin VB.Frame Frame1
Caption = "查询条件"
Height = 3255
Left = 840
TabIndex = 0
Top = 240
Width = 9015
Begin VB.CommandButton Com_Clear
Caption = "清除查询条件"
Height = 375
Left = 7200
TabIndex = 9
Top = 2040
Width = 1575
End
Begin VB.ComboBox Combo_Type
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000002&
Height = 315
Left = 6360
TabIndex = 8
Top = 480
Width = 855
End
Begin VB.CommandButton Com_Ok
Caption = "查询"
Height = 375
Left = 7200
TabIndex = 6
Top = 2640
Width = 1575
End
Begin VB.CommandButton Com_Create
Caption = "添加查询条件"
Height = 375
Left = 7200
TabIndex = 5
Top = 1080
Width = 1575
End
Begin VB.TextBox Text_Show
Height = 1215
Left = 480
TabIndex = 4
Top = 1920
Width = 6495
End
Begin VB.TextBox Text_Value
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 285
Left = 4080
TabIndex = 3
Top = 480
Width = 1815
End
Begin VB.ComboBox Combo_Act
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 315
Left = 2520
TabIndex = 2
Top = 480
Width = 1575
End
Begin VB.ComboBox Combo_Name
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 315
Left = 480
TabIndex = 1
Top = 480
Width = 1695
End
Begin VB.Line Line1
X1 = 0
X2 = 9000
Y1 = 1680
Y2 = 1680
End
End
End
Attribute VB_Name = "Form_Log"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ArrayName(4, 2) As String
Private Sub Com_Clear_Click()
Text_Show.Text = ""
End Sub
Private Sub Com_Create_Click()
Dim i As Integer
Dim strSql As String
strSql = " "
For i = 0 To Combo_Name.ListCount
If Trim(Combo_Name.Text) = ArrayName(i, 2) Then
strSql = ArrayName(i, 1)
Exit For
End If
Next
strSql = strSql & Combo_Act.Text
strSql = strSql & "'" & Text_Value.Text & "' "
If Len(Trim(Combo_Type.Text)) <> 0 Then
strSql = strSql & Combo_Type.Text & " "
End If
strSql = strSql & Chr(13)
Text_Show.Text = Text_Show.Text & strSql
End Sub
Private Sub Com_OK_Click()
Dim objRs As New ADODB.Recordset
Dim strSql As String
Dim myVal
On Error GoTo Err
If Len(Trim(Text_Show.Text)) <> 0 Then
strSql = "select * from zdk where " & Text_Show.Text
Else
strSql = "select * from zdk"
End If
'数据库连接
If CModule.IsConnect() = False Then
Err.Raise 90
End If
objRs.Open strSql, CModule.objCon, adOpenStatic, adLockOptimistic, adCmdText
If GridBrow(objRs) = False Then
Err.Raise 91
End If
CModule.CloseRs objRs
Exit Sub
Err:
Select Case Err.Number
Case 90
myVal = MsgBox("数据库连接失败", vbOKOnly, "查询")
Case 91
myVal = MsgBox("数据显示失败", vbOKOnly, "查询")
Case Else
myVal = MsgBox("系统错误，错误描述：" & Err.Description, vbOKOnly, "查询")
End Select
CModule.CloseRs objRs
End Sub
Private Sub Form_Load()
Dim objRs As New ADODB.Recordset
Dim strSql As String
Dim i As Integer
Dim myVal
On Error GoTo Err
'设置查询条件
ArrayName(0, 1) = "zdCode"
ArrayName(0, 2) = "编码"
ArrayName(1, 1) = "zdName"
ArrayName(1, 2) = "说明"
ArrayName(2, 1) = "zdbz"
ArrayName(2, 2) = "备注"
ArrayName(3, 1) = "zdDes"
ArrayName(3, 2) = "类型"
For i = 0 To 3
Combo_Name.AddItem (ArrayName(i, 2))
Next
Combo_Name.Text = ArrayName(0, 2)
Combo_Act.AddItem ("=")
Combo_Act.AddItem (">")
Combo_Act.AddItem ("<")
Combo_Act.AddItem ("<>")
Combo_Act.Text = "="
Combo_Type.AddItem ("")
Combo_Type.AddItem ("And")
Combo_Type.AddItem ("Or")
strSql = "select * from zdk"
'数据库连接
If CModule.IsConnect() = False Then
Err.Raise 90
End If
objRs.Open strSql, CModule.objCon, adOpenStatic, adLockOptimistic, adCmdText
If GridBrow(objRs) = False Then
Err.Raise 91
End If
CModule.CloseRs objRs
Exit Sub
Err:
Select Case Err.Number
Case 90
myVal = MsgBox("数据库连接失败", vbOKOnly, "查询")
Case 91
myVal = MsgBox("数据显示失败", vbOKOnly, "查询")
Case Else
myVal = MsgBox("系统错误，错误描述：" & Err.Description, vbOKOnly, "查询")
End Select
CModule.CloseRs objRs
End Sub
Private Function GridBrow(ByVal objRes As Object) As Boolean
Dim IntCount As Integer
On Error GoTo Err
Grid_Brow.Rows = objRes.RecordCount + 1
Grid_Brow.Cols = 4
Grid_Brow.Row = 0
Grid_Brow.Col = 0
Grid_Brow.Text = "编码"
Grid_Brow.Col = 1
Grid_Brow.Text = "说明"
Grid_Brow.Col = 2
Grid_Brow.Text = "备注"
Grid_Brow.Col = 3
Grid_Brow.Text = "类型"
For IntCount = 0 To 3
Grid_Brow.ColWidth(IntCount) = Grid_Brow.Width / 4
Grid_Brow.Row = 0
Grid_Brow.Col = IntCount
Grid_Brow.CellForeColor = &H8000000D
Grid_Brow.CellFontBold = True
Grid_Brow.CellFontSize = 12
Next
IntCount = 1
While Not objRes.EOF
Grid_Brow.Row = IntCount
Grid_Brow.Col = 0
Grid_Brow.Text = objRes("ZdCode")
Grid_Brow.Col = 1
Grid_Brow.Text = objRes("ZdName")
Grid_Brow.Col = 2
Grid_Brow.Text = objRes("Zdbz")
Grid_Brow.Col = 3
Grid_Brow.Text = objRes("ZdDes")
IntCount = IntCount + 1
objRes.MoveNext
Wend
CModule.CloseRs objRes
GridBrow = True
Exit Function
Err:
CModule.CloseRs objRes
GridBrow = False
End Function
Private Sub Grid_Brow_Click()
Status.Panels(1).Text = Grid_Brow.Text
'Grid_Brow.ToolTipText = Grid_Brow.Text
End Sub
Private Sub Grid_Brow_DblClick()
Dim strCode As String
Dim objRs As New ADODB.Recordset
Dim strSql As String
Dim mErr As String
On Error GoTo Err
Grid_Brow.SelectionMode = flexSelectionByRow
Grid_Brow.Col = 0
strCode = Trim(Grid_Brow.Text)
strSql = "select * from zdk where zdcode='" & strCode & "'"
If CModule.IsConnect() = False Then
Err.Raise 90
End If
objRs.Open strSql, CModule.objCon, adOpenStatic, adLockOptimistic, adCmdText
If objRs.EOF Then
Err.Raise 91
End If
If objRs("ftype") = 0 Then
Err.Raise 92
End If
If CModule.OpenFile(Trim(objRs("zdPath")), mErr) = False Then
Err.Raise 93
End If
CModule.CloseRs objRs
Exit Sub
Err:
Select Case Err.Number
Case 90
MsgBox "数据库连接失败"
Case 91
MsgBox "没有找到相应信息"
Case 92
MsgBox "此项目不是文件,不能打开"
Case 93
MsgBox mErr
Case Else
MsgBox "系统出错,错误信息:" & Err.Description
End Select
CModule.CloseRs objRs
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -