📄 findfrm.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Findfrm
BackColor = &H00E0E0E0&
BorderStyle = 3 'Fixed Dialog
Caption = "查找信息"
ClientHeight = 5535
ClientLeft = 45
ClientTop = 330
ClientWidth = 7680
Icon = "Findfrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5535
ScaleWidth = 7680
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
BackColor = &H005CE764&
Height = 60
Left = -60
TabIndex = 10
Top = 720
Width = 7815
End
Begin VB.TextBox txtBookBian
ForeColor = &H00000000&
Height = 270
Left = 885
TabIndex = 4
Text = "Text1"
Top = 960
Width = 3135
End
Begin VB.TextBox txtBookName
ForeColor = &H00000000&
Height = 270
Left = 885
TabIndex = 3
Text = "Text1"
Top = 1380
Width = 3135
End
Begin MSComctlLib.ListView LV
Height = 2715
Left = 45
TabIndex = 2
Top = 2400
Width = 7545
_ExtentX = 13309
_ExtentY = 4789
LabelEdit = 1
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = 32768
BackColor = 16777215
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.CommandButton cmdKong
BackColor = &H00FFFFFF&
Caption = "全部清空(&L)"
Height = 375
Left = 4605
Style = 1 'Graphical
TabIndex = 1
ToolTipText = "清空所有文本"
Top = 1395
Width = 1335
End
Begin VB.CommandButton cmdBeginFind
BackColor = &H00FFFFFF&
Caption = "开始查找(&F)"
Height = 375
Left = 4605
Style = 1 'Graphical
TabIndex = 0
ToolTipText = "开始查找符合条件的记录"
Top = 915
Width = 1335
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入要查找的条件进行查询"
ForeColor = &H00800000&
Height = 180
Left = 615
TabIndex = 9
Top = 390
Width = 2340
End
Begin VB.Image Image1
Height = 480
Left = 120
Picture = "Findfrm.frx":058A
Top = 120
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "信息编号"
ForeColor = &H00800000&
Height = 180
Index = 0
Left = 105
TabIndex = 8
Top = 1005
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "名 称"
ForeColor = &H00800000&
Height = 180
Index = 1
Left = 120
TabIndex = 7
Top = 1425
Width = 630
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "提示:信息查询可输入*来代替多个字符"
ForeColor = &H00404040&
Height = 180
Left = 885
TabIndex = 6
Top = 1770
Width = 3060
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "进行模糊查找"
ForeColor = &H00404040&
Height = 180
Left = 885
TabIndex = 5
Top = 2010
Width = 1080
End
Begin VB.Shape Shape1
BackColor = &H00D0D0D0&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 750
Left = -15
Top = -15
Width = 8310
End
End
Attribute VB_Name = "Findfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rst1 As Recordset '打开表Book
Dim rst2 As Recordset '打开表BookFf
Dim rst As Recordset
Dim db1 As Database
Dim db2 As Database
Dim qry1 As QueryDef
Dim qry2 As QueryDef
Dim RecNum As Integer '查找符合条件总记录数
Dim i As Integer
Dim FindStr As String '查找SQL语句
Private Sub cmdBeginFind_Click()
If txtBookBian = "" And txtBookName = "" Then
MsgBox "请填写相关查找信息！", 0 + 48, "提示"
txtBookBian.SetFocus
Exit Sub
End If
Lv.ListItems.Clear
Findfrm.MousePointer = 11
If txtBookBian <> "" And txtBookName = "" Then
rst1.Seek "=", txtBookBian
If rst1.NoMatch Then
MsgBox "没有找到匹配记录！", 0 + 48, "查找失败"
Findfrm.MousePointer = 0
Exit Sub
End If
If rst1.Fields("是否修改") = True Then
rst2.Seek "=", txtBookBian
Lv.ListItems.Add , , rst1.Fields("信息编号") & vbNullString
With Lv.ListItems(1)
.SubItems(1) = rst1.Fields("名称") & vbNullString
.SubItems(2) = rst1.Fields("类别") & vbNullString
.SubItems(3) = rst1.Fields("值") & Empty
.SubItems(4) = rst1.Fields("描述") & vbNullString
.SubItems(5) = rst1.Fields("是否修改")
.SubItems(6) = rst2.Fields("查询证号") & vbNullString
.SubItems(7) = rst2.Fields("姓名") & vbNullString
.SubItems(8) = rst2.Fields("日期")
End With
Else
Lv.ListItems.Add , , rst1.Fields("信息编号") & vbNullString
With Lv.ListItems(1)
.SubItems(1) = rst1.Fields("名称") & vbNullString
.SubItems(2) = rst1.Fields("类别") & vbNullString
.SubItems(3) = rst1.Fields("值") & Empty
.SubItems(4) = rst1.Fields("描述") & vbNullString
.SubItems(5) = rst1.Fields("是否修改")
End With
End If
ElseIf txtBookBian = "" And txtBookName <> "" Then
FindStr = "select * from Book where 名称 like"
FindStr = FindStr & "'" & txtBookName & "'"
qry1.SQL = FindStr
Set rst = qry1.OpenRecordset(2)
If rst.RecordCount = 0 Then
MsgBox "没有找到匹配记录！", 0 + 48, "查找失败"
Findfrm.MousePointer = 0
Exit Sub
End If
rst.MoveLast
RecNum = rst.RecordCount
rst.MoveFirst
For i = 1 To RecNum
If rst.Fields("是否修改") = True Then
rst2.Seek "=", rst.Fields("信息编号")
Lv.ListItems.Add i, , rst.Fields("信息编号") & vbNullString
With Lv.ListItems(i)
.SubItems(1) = rst.Fields("名称") & vbNullString
.SubItems(2) = rst.Fields("类别") & vbNullString
.SubItems(3) = rst.Fields("值") & Empty
.SubItems(4) = rst.Fields("描述") & vbNullString
.SubItems(5) = rst.Fields("是否修改")
.SubItems(6) = rst2.Fields("查询证号") & vbNullString
.SubItems(7) = rst2.Fields("姓名") & vbNullString
.SubItems(8) = rst2.Fields("日期")
End With
Else
Lv.ListItems.Add i, , rst.Fields("信息编号") & vbNullString
With Lv.ListItems(i)
.SubItems(1) = rst.Fields("名称") & vbNullString
.SubItems(2) = rst.Fields("类别") & vbNullString
.SubItems(3) = rst.Fields("值") & Empty
.SubItems(4) = rst.Fields("描述") & vbNullString
.SubItems(5) = rst.Fields("是否修改")
End With
End If
rst.MoveNext
If rst.EOF Then Exit For
Next
Else
MsgBox "请选择一项进行查找", 0 + 48, "提示"
txtBookBian = ""
txtBookName = ""
txtBookBian.SetFocus
Findfrm.MousePointer = 0
Exit Sub
End If
Findfrm.MousePointer = 0
End Sub
Private Sub cmdKong_Click()
txtBookBian = ""
txtBookName = ""
Lv.ListItems.Clear
txtBookBian.SetFocus
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set db1 = Workspaces(0).OpenDatabase(App.Path & "\Database\Data.mdb", False)
Set rst1 = db1.OpenRecordset("Book", dbOpenTable)
Set qry1 = db1.CreateQueryDef("")
rst1.Index = "信息编号"
Set db2 = Workspaces(0).OpenDatabase(App.Path & "\Database\Data.mdb", False)
Set rst2 = db2.OpenRecordset("BookFf", dbOpenTable)
Set qry2 = db2.CreateQueryDef("")
rst2.Index = "信息编号"
txtBookBian = ""
txtBookName = ""
Lv.View = lvwReport
Lv.GridLines = False
Lv.ColumnHeaders.Add , , "信息编号"
Lv.ColumnHeaders.Add , , "名称"
Lv.ColumnHeaders.Add , , "类别"
Lv.ColumnHeaders.Add , , "值"
Lv.ColumnHeaders.Add , , "描述"
Lv.ColumnHeaders.Add , , "是否修改"
Lv.ColumnHeaders.Add , , "查询证号"
Lv.ColumnHeaders.Add , , "查询人姓名"
Lv.ColumnHeaders.Add , , "修改日期"
End Sub
Private Sub txtBookBian_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtBookName.Text = ""
cmdBeginFind_Click
End If
End Sub
Private Sub txtBookName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtBookBian.Text = ""
cmdBeginFind_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -