📄 frmlog.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmLog
Caption = "日志管理"
ClientHeight = 6555
ClientLeft = 60
ClientTop = 345
ClientWidth = 7680
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6555
ScaleWidth = 7680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdAll
Caption = "全部"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6480
TabIndex = 12
Top = 5895
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6480
TabIndex = 11
Top = 2115
Width = 1095
End
Begin VB.CommandButton cmdDelete
Caption = "删除"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6480
TabIndex = 10
Top = 1290
Width = 1095
End
Begin VB.CommandButton cmdFind
Caption = "查询"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6480
TabIndex = 9
Top = 465
Width = 1095
End
Begin VB.Frame Frame2
Caption = "筛选"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 780
Left = 135
TabIndex = 2
Top = 5670
Width = 6180
Begin VB.ComboBox cmbCj
Height = 300
ItemData = "frmLog.frx":0000
Left = 4920
List = "frmLog.frx":0007
TabIndex = 8
Top = 330
Width = 1095
End
Begin VB.ComboBox cmbTime
Height = 300
ItemData = "frmLog.frx":0011
Left = 2835
List = "frmLog.frx":0018
TabIndex = 7
Top = 360
Width = 1095
End
Begin VB.ComboBox cmbBf
Height = 300
ItemData = "frmLog.frx":0022
Left = 750
List = "frmLog.frx":0029
TabIndex = 6
Top = 360
Width = 1095
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "处警动作："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 4140
TabIndex = 5
Top = 405
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "触发时间："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 1995
TabIndex = 4
Top = 420
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "布防名："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 105
TabIndex = 3
Top = 420
Width = 720
End
End
Begin MSComctlLib.ListView lvwLog
Height = 5055
Left = 120
TabIndex = 0
Top = 480
Width = 6180
_ExtentX = 10901
_ExtentY = 8916
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "日志记录："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 195
TabIndex = 1
Top = 240
Width = 900
End
End
Attribute VB_Name = "frmLog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private strbf As String '=cmbbf的文本值
Private strcj As String '=cmbcj的文本值
Private strdate As String '=cmbdate的文本值 只显示日期不显示时刻
'点击command:All
Private Sub cmdAll_Click()
lvwLog.ListItems.Clear '清空listview准备写入新item
Dim rs As ADODB.Recordset 'ADO方式打开记录集
Set rs = New ADODB.Recordset
Dim str As String
str = "select * from log"
rs.Open str, cn, adOpenStatic, adLockOptimistic
If rs.RecordCount = 0 Then Exit Sub '如果无纪录则不用显示
'添加新的item在listview中
Dim itemx As ListItem
While Not rs.EOF
Set itemx = lvwLog.ListItems.Add(Text:=rs!bfname)
Debug.Print rs!Date & Space(1) & rs!Time
itemx.ListSubItems.Add Text:=rs!Date & Space(1) & rs!Time
itemx.ListSubItems.Add Text:=rs!cjname
rs.MoveNext
Wend
rs.Close '关闭记录集
End Sub
'点击command:Delete
Private Sub cmdDelete_Click()
If MsgBox("确实要删除该项纪录吗？", vbYesNo, 询问) = vbYes Then
strbf = Trim(cmbBf.Text) '记录bfname
strcj = Trim(cmbCj.Text) '记录cjname
strdate = Trim(cmbTime.Text) '记录发生的日期date
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim mitem As ListItem
rs.Open sqlGet, cn, adOpenStatic, adLockOptimistic
If rs.RecordCount = 0 Then Exit Sub
While Not rs.EOF
Set mitem = lvwLog.FindItem(rs!bfname, , , lvwPartial)
lvwLog.ListItems.Remove mitem.index
rs.Delete
rs.MoveNext
Wend
End If
End Sub
'点击command:Find
Private Sub cmdFind_Click()
strbf = Trim(cmbBf.Text) '记录bfname
strcj = Trim(cmbCj.Text) '记录cjname
strdate = Trim(cmbTime.Text) '记录发生的日期date
If strbf = "" Or strcj = "" Or strdate = "" Then
Dim a As Integer
a = MsgBox("筛选条件不足，请重新筛选", , 重要提示)
Exit Sub
End If
'打开log表进行查询
Dim r As ADODB.Recordset
Set r = New ADODB.Recordset
r.Open sqlGet, cn, adOpenDynamic, adLockOptimistic
'将查询结果显示在listview上面
lvwLog.ListItems.Clear
Dim itemx As ListItem
While Not r.EOF
Set itemx = lvwLog.ListItems.Add(Text:=r!bfname)
itemx.ListSubItems.Add Text:=r!Date & Space(1) & r!Time
itemx.ListSubItems.Add Text:=r!cjname
r.MoveNext
Wend
r.Close
End Sub
Private Function sqlGet() As String
strbf = Trim(cmbBf.Text) '记录bfname
strcj = Trim(cmbCj.Text) '记录cjname
strdate = Trim(cmbTime.Text) '记录发生的日期date
Dim s As String
s = "select * from log where"
If strbf <> "全部" Then
s = s & " bfname = '" & strbf & "'and"
End If
If strdate <> "全部" Then
s = s & " date = #" & CDate(strdate) & "# and"
End If
If strcj <> "全部" Then
s = s & " cjname = '" & strcj & "'"
End If
If Right(s, 1) = "d" Then s = Trim(Left(s, Len(s) - 3))
If Right(s, 1) = "e" Then s = Trim(Left(s, Len(s) - 5))
sqlGet = s
End Function
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Left = (frmMain.Width - Me.Width) / 2
Me.Top = (frmMain.Height - Me.Height) / 2
Call Init
End Sub
Private Sub makecolumns()
lvwLog.View = lvwReport
lvwLog.FullRowSelect = True
lvwLog.ColumnHeaders.Clear
lvwLog.ColumnHeaders.Add , , "布控名称", lvwLog.Width / 5
lvwLog.ColumnHeaders.Add , , "时间", lvwLog.Width / 5
lvwLog.ColumnHeaders.Add , , "动作", lvwLog.Width * 2.9 / 5
End Sub
Private Sub Init()
'添加表头
Call makecolumns
'打开纪录集Log
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim str As String
str = "select * from log"
rs.Open str, cn, adOpenDynamic, adLockOptimistic
If rs.EOF Or rs.BOF Then Exit Sub
'添加下拉框内容
Dim itemx As ListItem
While Not rs.EOF
cmbBf.AddItem rs!bfname
cmbTime.AddItem rs!Date
cmbCj.AddItem rs!cjname
Set itemx = lvwLog.ListItems.Add(Text:=rs!bfname)
itemx.ListSubItems.Add Text:=rs!Date & Space(1) & rs!Time
itemx.ListSubItems.Add Text:=rs!cjname
rs.MoveNext
Wend
rs.Close
cmbBf.ListIndex = 0
cmbTime.ListIndex = 0
cmbCj.ListIndex = 0
End Sub
Private Sub lvwLog_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'单击 ColumnHeader 对象时，将根据
'那一列的子项目把 ListView 控件排序。
'设置 SortKey 为 ColumnHeader 的索引值减 1
lvwLog.SortKey = ColumnHeader.index - 1
'设置 Sorted 为 True 以将列表排序。
lvwLog.Sorted = True
'设置sortorder为当前sortorder的反序
Select Case lvwLog.SortOrder
Case lvwDescending
lvwLog.SortOrder = lvwAscending
Case lvwAscending
lvwLog.SortOrder = lvwDescending
Case Else
MsgBox ("error")
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -