?? frmfind.frm
字號:
VERSION 5.00
Begin VB.Form frmFind
BorderStyle = 1 'Fixed Single
Caption = "Find"
ClientHeight = 3225
ClientLeft = 3090
ClientTop = 6150
ClientWidth = 6075
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3225
ScaleWidth = 6075
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Height = 2295
Left = 120
TabIndex = 1
Top = 840
Width = 5895
Begin PhoneBook.chameleonButton cmdCancel
Height = 375
Left = 4320
TabIndex = 11
Top = 1680
Width = 1215
_ExtentX = 2143
_ExtentY = 661
BTYPE = 3
TX = "&Cancel"
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 14215660
FCOL = 0
End
Begin PhoneBook.chameleonButton cmdFindNext
Height = 375
Left = 4320
TabIndex = 10
Top = 720
Width = 1215
_ExtentX = 2143
_ExtentY = 661
BTYPE = 3
TX = "&Find Next"
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 14215660
FCOL = 0
End
Begin PhoneBook.chameleonButton cmdFindFirst
Height = 375
Left = 4320
TabIndex = 9
Top = 240
Width = 1215
_ExtentX = 2143
_ExtentY = 661
BTYPE = 3
TX = "&Find"
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 14215660
FCOL = 0
End
Begin VB.ComboBox cboField
Height = 315
Left = 1200
Style = 2 'Dropdown List
TabIndex = 5
Top = 480
Width = 3015
End
Height = 315
Left = 1200
TabIndex = 4
Top = 960
Width = 3015
End
Begin VB.CheckBox chkKonfirmasi
Caption = "&Display the complete data in found record"
Height = 255
Left = 120
TabIndex = 3
Top = 1800
Value = 1 'Checked
Width = 3855
End
Begin VB.CheckBox chkMatch
Caption = "&Match whole word only"
Height = 255
Left = 120
TabIndex = 2
Top = 1440
Width = 2175
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Find in Field:"
Height = 255
Left = 120
TabIndex = 7
Top = 480
Width = 975
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Find what:"
Height = 255
Left = 120
TabIndex = 6
Top = 960
Width = 975
End
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Find Data - PhoneBook 2006"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00E0E0E0&
Height = 195
Left = 960
TabIndex = 8
Top = 240
Width = 2460
End
Begin VB.Image Image1
Height = 480
Left = 240
Picture = "frmFind.frx":0000
Top = 120
Width = 480
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 0
X2 = 8880
Y1 = 720
Y2 = 720
End
Begin VB.Image imgLogo
Height = 1335
Left = 3240
Picture = "frmFind.frx":0442
Stretch = -1 'True
Top = -600
Width = 3330
End
Begin VB.Label Label5
BackColor = &H00808080&
Height = 735
Left = -120
TabIndex = 0
Top = 0
Width = 8415
End
End
Attribute VB_Name = "frmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Dim adoField1 As ADODB.Field
Dim mark As Variant, intCount As Integer, intPosition As Integer
Dim bFound As Boolean, bCancel As Boolean
Dim strFind As String, strFindNext As String, strResult As String
Private Sub cboField_Click()
If cboField.Text = "(All Fields)" Then
chkMatch.Value = 0
chkMatch.Enabled = False
Else
chkMatch.Enabled = True
End If
Private Sub cboFind_Change()
If Len(Trim(cboFind.Text)) > 0 Then
cmdFindFirst.Enabled = True
cmdFindFirst.Default = True
Else
cmdFindFirst.Enabled = False
cmdFindNext.Enabled = False
End If
End Sub
Private Sub cboFind_Click()
If Len(Trim(cboFind.Text)) > 0 Then
cmdFindFirst.Enabled = True
cmdFindFirst.Default = True
Else
cmdFindFirst.Enabled = False
End If
End Sub
Private Sub cboField_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cboFind.SetFocus
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub cmdFindFirst_Click()
Dim strFound As String
Dim i As Integer
'If criteria is not (All Fields)
If Trim(cboField.Text) <> "(All Fields)" Then
On Error GoTo Message
intCount = 0
CheckDouble
adoFind.MoveFirst
bFound = False 'Not found yet
Do While adoFind.EOF <> True
DoEvents
If bCancel = True Then 'If use interrupt by clicking
'Cancel button...
Exit Sub '... exit from this procedure
End If
If chkMatch.Value = 0 Then 'Not match whole word
If InStr(UCase(adoFind.Fields(cboField.Text)), UCase(cboFind.Text)) > 0 Then
DoEvents
intCount = intCount + 1
DoEvents
'Get the absolute position
intPosition = adoFind.AbsolutePosition
'We found it, update bFound now
bFound = True
Else 'Match whole word only
If UCase(adoFind.Fields(cboField.Text)) = UCase(cboFind.Text) Then
DoEvents
intCount = intCount + 1
DoEvents
'Get the absolute position
intPosition = adoFind.AbsolutePosition
'We found it, update bFound now
bFound = True
End If
End If
If intCount = 1 Then 'If this is the first found
bFound = True 'Update bFound
Exit Do 'Exit from this looping, because
'this is only the first time
End If
DoEvents
adoFind.MoveNext
Loop
'If we found and intCount <> 0
If bFound = True And intCount <> 0 Then
cmdFindNext.Enabled = True
'Display what position we found...
strFound = "Found '" & cboFind.Text & "' in record number " & adoFind.AbsolutePosition
'This will get the name of field
For i = 0 To adoFind.Fields.Count - 1
If adoFind.Fields(i).Name = "ChildCMD" Then
Exit For
End If
'Get all data in record we found
strFound = strFound & vbCrLf & _
adoFind.Fields(i).Name & ": " & _
vbTab & adoFind.Fields(i).Value
Next i
End If
'If chkKonfirmasi was checked by user and data found
If chkKonfirmasi.Value = 1 And bFound = True Then
'Display in messagebox
MsgBox strFound, vbInformation, "Found"
End If
If (adoFind.EOF) Then 'If pointer in end of recordset
adoFind.MoveLast 'move to the last record
bFound = False 'so, we haven't found it yet
'Display messagebox we haven't found it
MsgBox "" & cboFind.Text & " not found " & _
"in field '" & cboField.Text & "'.", _
vbExclamation, "Finished Searching"
'cmdFindNext is not active because we haven't found
'in cmdFindFirst
cmdFindNext.Enabled = False
Exit Sub
End If
Exit Sub
Else 'If user select (All Fields)
FindFirstInAllFields '<-- call this procedure
Exit Sub
End If
Message:
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -