📄 frmfind.frm
字号:
VERSION 5.00
Object = "{653A556A-745E-476A-BB7C-20AB9DC0A4FB}#5.0#0"; "EXBUTTON.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmFind
Caption = "电子通讯录-查询记录"
ClientHeight = 6345
ClientLeft = 60
ClientTop = 345
ClientWidth = 9315
Icon = "frmFind.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6345
ScaleWidth = 9315
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = "查询条件"
ForeColor = &H00FF00FF&
Height = 2415
Left = 0
TabIndex = 1
Top = 3840
Width = 9255
Begin EXButton.ExBtn cmdRefut
Height = 375
Left = 7800
TabIndex = 13
Top = 1680
Width = 1215
_ExtentX = 2143
_ExtentY = 661
ForeColor = 16711680
CRad = 3
Caption = "刷 新"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin EXButton.ExBtn cmdFind
Default = -1 'True
Height = 375
Left = 7800
TabIndex = 10
Top = 1200
Width = 1215
_ExtentX = 2143
_ExtentY = 661
ForeColor = 16711680
CRad = 3
Skin = "frmFind.frx":030A
Style = 4
Caption = "查 询"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox txtResult
Height = 375
Left = 1320
TabIndex = 9
Top = 1080
Width = 2295
End
Begin VB.ComboBox cmbTJ
Height = 300
ItemData = "frmFind.frx":19AE
Left = 5160
List = "frmFind.frx":19B0
TabIndex = 8
Top = 360
Width = 1215
End
Begin VB.ComboBox cmbXM
Height = 300
Left = 1320
TabIndex = 7
Top = 360
Width = 2295
End
Begin VB.OptionButton optMH
Caption = "模糊查找"
Height = 255
Left = 1440
TabIndex = 6
Top = 1680
Width = 1095
End
Begin VB.OptionButton optJQ
Caption = "精确查找"
Height = 255
Left = 240
TabIndex = 5
Top = 1680
Width = 1095
End
Begin VB.Label lblTJ
AutoSize = -1 'True
Height = 180
Left = 2640
TabIndex = 14
Top = 2040
Width = 90
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "条件值："
Height = 180
Left = 360
TabIndex = 4
Top = 1080
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "查询条件："
Height = 180
Left = 4200
TabIndex = 3
Top = 360
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "查询项目："
Height = 180
Left = 360
TabIndex = 2
Top = 360
Width = 900
End
End
Begin VB.Frame Frame1
Caption = "查询结果"
ForeColor = &H00FF00FF&
Height = 3615
Left = 0
TabIndex = 0
Top = 120
Width = 9255
Begin MSFlexGridLib.MSFlexGrid mfgResult
Height = 3015
Left = 120
TabIndex = 11
Top = 240
Width = 9015
_ExtentX = 15901
_ExtentY = 5318
_Version = 393216
BackColorSel = 16406603
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 3
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "双击姓名可以显示详细资料"
ForeColor = &H000000FF&
Height = 180
Left = 6960
TabIndex = 12
Top = 3360
Width = 2160
End
End
End
Attribute VB_Name = "frmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public numXM As Integer '表示查询项目
Public numTJ As Integer '表示查询条件
Dim mrcFind As ADODB.Recordset
Private Sub cmbTJ_Click()
Dim i As Integer
'记录选中条件的序号
For i = 0 To cmbTJ.ListCount - 1
numTJ = cmbTJ.ListIndex
Next
End Sub
Private Sub cmbXM_Click()
Dim i As Integer
'记录选中项目的序号
For i = 0 To cmbXM.ListCount - 1
numXM = cmbXM.ListIndex
Next
End Sub
Private Sub cmdFind_Click()
Dim txtSQL As String
'判断查询条件是否输入正确
If Len(cmbXM.Text) = 0 Then
MsgBox "请先选择查询项目！", vbOKOnly + vbExclamation, "电子通讯录-提示"
cmbXM.SetFocus
Exit Sub
End If
If Len(cmbTJ.Text) = 0 Then
MsgBox "请先选择查询条件！", vbOKOnly + vbExclamation, "电子通讯录-提示"
cmbTJ.SetFocus
Exit Sub
End If
If numTJ <> 6 Then '查询条件不等于<All>
If Len(txtResult.Text) = 0 Then
MsgBox "请先输入条件值！", vbOKOnly + vbExclamation, "电子通讯录-提示"
txtResult.SetFocus
Exit Sub
End If
End If
If cmbXM.Text = "生日" Then
If numTJ <> 6 And optMH.Value = False Then
'判断日期格式是否输入正确
If Trim(txtResult.Text) Like "??-??" Then '判断是否按指定格式填写
Dim strDate As String
strDate = Left(Trim(txtResult.Text), 2) & Right(Trim(txtResult.Text), 2)
If Not IsNumeric(strDate) Then
MsgBox "日期请输入数字！", vbOKOnly + vbExclamation, "电子通讯录-提示"
txtResult.SetFocus
Exit Sub
End If
If Left(Trim(txtResult.Text), 2) > 12 Then '判断月份输入是否正确
MsgBox "月份不能超过12！", vbOKOnly + vbExclamation, "电子通讯录-提示"
txtResult.SetFocus
Exit Sub
End If
If (Right(Trim(txtResult.Text), 2) > 31) Or _
((Left(Trim(txtResult.Text), 2) = 2) And (Right(Trim(txtResult.Text), 2)) > 29) Then
'判断日期是否输入正确
MsgBox "日期不能大于31天，如果是2月份则不能大于29天！", vbOKOnly + vbExclamation, "电子通讯录-提示"
txtResult.SetFocus
Exit Sub
End If
Else
MsgBox "日期请按 mm-dd 格式填写", vbOKOnly + vbExclamation, "电子通讯录-提示"
txtResult.SetFocus
Exit Sub
End If
End If
End If
'全部检验通过，则根据条件生成相应的SQL语句
txtSQL = "select * from Tbl_Txb"
'---------------------------------------------------
' 根据选中项目的序号为SQL语句添加过滤条件
'---------------------------------------------------
If numTJ <> 6 Then '排除选择了<All>的时候
'若选择了精确查找
If optJQ.Value = True Then
Select Case numXM '根据查询项目的选项
Case 0
txtSQL = txtSQL & " where 姓名 " & cmbTJ.List(numTJ) & "'" & Trim(txtResult.Text) & "'"
Case 1
txtSQL = txtSQL & " where 生日 " & cmbTJ.List(numTJ) & "'" & Trim(txtResult.Text) & "'"
End Select
End If
'若选择了模糊查找
If optMH.Value = True Then
If numTJ = 0 Then '若选择了包含
Select Case numXM
Case 0
txtSQL = txtSQL & " where 姓名 like '%" & Trim(txtResult.Text) & "%'"
Case 1
txtSQL = txtSQL & " where 生日 like '%" & Trim(txtResult.Text) & "%'"
End Select
End If
If numTJ = 1 Then '若选择了不包含
Select Case numXM
Case 0
txtSQL = txtSQL & " where 姓名 not like '%" & Trim(txtResult.Text) & "%'"
Case 1
txtSQL = txtSQL & " where 生日 not like '%" & Trim(txtResult.Text) & "%'"
End Select
End If
End If
End If
Set mrcFind = ExecuteSQL(txtSQL) '执行SQL语句
If mrcFind.RecordCount = 0 Then
MsgBox "找不到记录，记录表为空或请确认输入条件是否正确！", vbOKOnly + vbInformation, "电子通讯录-提示"
Exit Sub
End If
With mfgResult '控制控件显示指定的5个记录
.FixedRows = 1
.FixedCols = 1
.Rows = mrcFind.RecordCount + 1
.Cols = 6
.TextMatrix(0, 1) = " 姓名"
.TextMatrix(0, 2) = "性别"
.TextMatrix(0, 3) = " 生日"
.TextMatrix(0, 4) = " 电话"
.TextMatrix(0, 5) = " 联系地址"
.ColWidth(0) = 300
.ColWidth(1) = 800
.ColWidth(2) = 500
.ColWidth(3) = 1000
.ColWidth(4) = 1300
.ColWidth(5) = 2000
End With
Call ShowDate '调用过程显示数据
'For i = 0 To mrcFind.Fields.Count - 1
' mfgResult.TextMatrix(0, i) = mrcFind.Fields(i).Name
'Next
'
'For i = 1 To mrcFind.RecordCount - 1
' For j = 0 To mrcFind.Fields.Count - 1
' mfgResult.TextMatrix(i, j) = mrcFind.Fields(j)
' Next
' mrcFind.MoveNext
' If mrcFind.EOF = True Then
' Exit Sub
' End If
'Next
End Sub
Private Sub cmdRefut_Click()
Call cmdFind_Click
End Sub
Private Sub Form_Activate()
If ShowBirthday_Result = True Then
Call cmdFind_Click
End If
End Sub
Private Sub Form_Load()
'添加查询项目选项
cmbXM.Clear
cmbXM.AddItem "姓名"
cmbXM.AddItem "生日"
optJQ.Value = True
cmdRefut.Enabled = False
lblTJ.Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
ShowBirthday_Result = False
End Sub
Private Sub mfgResult_DblClick()
PictureForfrmFind = True
ViewJLName = Trim(mfgResult.Text)
If (frmEditJL.ShowMe = 1) Then '调用修改窗体
mfgResult.RemoveItem mfgResult.Row '移去被删除的记录
End If
End Sub
Private Sub optJQ_Click()
If optJQ.Value = True Then
'添加查询条件选项
cmbTJ.Clear
cmbTJ.AddItem "="
cmbTJ.AddItem ">"
cmbTJ.AddItem "<"
cmbTJ.AddItem ">="
cmbTJ.AddItem "<="
cmbTJ.AddItem "<>"
cmbTJ.AddItem "<All>"
End If
End Sub
Private Sub optMH_Click()
If optMH.Value = True Then
cmbTJ.Clear
cmbTJ.AddItem "包含"
cmbTJ.AddItem "不包含"
End If
End Sub
Public Sub ShowDate()
Dim i As Integer
Dim Boy_Num As Integer
Dim Girl_Num As Integer
For i = 1 To mrcFind.RecordCount
mfgResult.TextMatrix(i, 0) = i
mfgResult.TextMatrix(i, 1) = Trim(mrcFind.Fields(0))
mfgResult.TextMatrix(i, 2) = Trim(mrcFind.Fields(1))
mfgResult.TextMatrix(i, 3) = Trim(mrcFind.Fields(5))
mfgResult.TextMatrix(i, 4) = Trim(mrcFind.Fields(3))
mfgResult.TextMatrix(i, 5) = Trim(mrcFind.Fields(8))
mrcFind.MoveNext
If mrcFind.EOF = True Then
Exit For
End If
Next
lblTJ.Visible = True
lblTJ.Caption = "查到 " & mrcFind.RecordCount & " 条记录"
For i = 0 To mrcFind.RecordCount
If Trim(mfgResult.TextMatrix(i, 2)) = "男" Then
Boy_Num = Boy_Num + 1
ElseIf Trim(mfgResult.TextMatrix(i, 2) = "女") Then
Girl_Num = Girl_Num + 1
End If
Next
lblTJ.Caption = lblTJ.Caption & ",其中有男生记录 " & Boy_Num & " 条，女生记录 " & Girl_Num & " 条"
cmdRefut.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -