📄 frmfind.frm
字号:
VERSION 5.00
Begin VB.Form frmFind
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Dest"
ClientHeight = 3675
ClientLeft = 45
ClientTop = 330
ClientWidth = 5415
ControlBox = 0 'False
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3675
ScaleWidth = 5415
StartUpPosition = 1 'CenterOwner
Begin VB.ComboBox cbFindDirection
Height = 315
ItemData = "frmFind.frx":0000
Left = 1440
List = "frmFind.frx":000D
TabIndex = 13
Top = 2160
Width = 2295
End
Begin VB.ComboBox cbReplace
Height = 315
Left = 1440
TabIndex = 11
Top = 1560
Width = 2295
End
Begin VB.CommandButton CmdReplaceAll
Caption = "全部替换(&A)"
Height = 495
Left = 3960
TabIndex = 10
Top = 2640
Width = 1335
End
Begin VB.CommandButton cmdReplace
Caption = "替换(&R)"
Height = 495
Left = 3960
TabIndex = 9
Top = 1920
Width = 1335
End
Begin VB.CheckBox checkWholeWords
BackColor = &H80000005&
Caption = "全字匹配"
Height = 495
Left = 960
TabIndex = 5
Top = 2640
Width = 1215
End
Begin VB.CheckBox checkMatchCase
BackColor = &H80000005&
Caption = "区分大小写"
Height = 495
Left = 2400
TabIndex = 4
Top = 2640
Width = 1215
End
Begin VB.ComboBox cbFind
Height = 315
Left = 1440
TabIndex = 3
Top = 960
Width = 2295
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 375
Left = 3960
MaskColor = &H8000000F&
TabIndex = 1
Top = 1440
Width = 1335
End
Begin VB.CommandButton cmdFindNext
Caption = "查找下一个(&F)"
Default = -1 'True
DownPicture = "frmFind.frx":0020
Height = 495
Left = 3960
TabIndex = 0
Top = 840
Width = 1335
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000001&
BorderStyle = 0 'None
FillStyle = 0 'Solid
FontTransparent = 0 'False
ForeColor = &H80000008&
Height = 735
Left = 960
ScaleHeight = 735
ScaleWidth = 4455
TabIndex = 6
Top = 0
Width = 4455
End
Begin VB.Label Label5
BackColor = &H80000005&
Caption = "查找方向"
Height = 375
Left = 240
TabIndex = 14
Top = 2160
Width = 855
End
Begin VB.Label lblReplace
BackColor = &H80000005&
Caption = "替换内容"
Height = 375
Left = 240
TabIndex = 12
Top = 1560
Width = 855
End
Begin VB.Line Line2
BorderColor = &H80000005&
X1 = 0
X2 = 5400
Y1 = 3480
Y2 = 3480
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "查找"
BeginProperty Font
Name = "华文新魏"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 375
Left = 120
TabIndex = 8
Top = 240
Width = 615
End
Begin VB.Line Line1
BorderColor = &H80000005&
X1 = 0
X2 = 5400
Y1 = 3300
Y2 = 3300
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000001&
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 0
TabIndex = 7
Top = 0
Width = 1215
End
Begin VB.Label Label1
BackColor = &H80000005&
Caption = "查找内容"
Height = 375
Left = 240
TabIndex = 2
Top = 960
Width = 855
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 FindOptions As Long '查找选项
'*************************************************
' 目的: 调用查找下一个。
'*************************************************
Public Sub cmdFindNext_Click()
FindOptions = IIf(frmFind.checkWholeWords.value, rtfWholeWord, 0) + _
IIf(frmFind.checkMatchCase.value, rtfMatchCase, 0)
Dim lngLen As Long '结束位置
Dim lngStart As Long '开始位置
'设置框内的文字的结尾长度
lngLen = Len(fMainForm.ActiveForm.rtfText.Text)
Select Case cbFindDirection.ListIndex
Case 0 '搜索全部
lngStart = 1
Case 1 '向后搜索
lngStart = 1
'设置当前选择的结尾
lngLen = fMainForm.ActiveForm.rtfText.SelStart
lngLen = lngLen + fMainForm.ActiveForm.rtfText.SelLength
Case 2 '向前搜索
'设置当前选择的开头
lngStart = fMainForm.ActiveForm.rtfText.SelStart
lngStart = lngStart + fMainForm.ActiveForm.rtfText.SelLength
End Select
'Call the function to do the find.
If Not FindString(cbFind.Text, "", lngStart, lngLen) Then
MsgBox "未找到匹配字符串。 " + vbCrLf, vbApplicationModal _
+ vbExclamation, "查找"
Else
' Unload Me
End If
If (Not IfExist(cbFind.Text)) Then _
cbFind.AddItem cbFind.Text
End Sub
'************************************************
' 目的: 如果需要查找一个字符窗并且替换它
' 作用: 调用窗体的文字可能会改变。
' 输入: strFind: 要查找的文字
' strReplace: 查找到的文字后要的替换文字
' intStart: 开始的查找点
' intEnd: 查找范围
' 返回: True 文字已找到(并替换了)
' Flase 文字未找到
'*************************************************
Function FindString(strFind As String, strReplace As String, lngStart As Long, lngEnd As Long) As Boolean
Dim lngPos As Long '位置
With fMainForm.ActiveForm.rtfText
'定位查找字符串
lngPos = InStr(lngStart, .Text, strFind, 1)
If lngPos = 0 Then
'未找到
FindString = False
Else
'它被找到了，但是超过了结尾区域，我们将做
If Not ((lngPos + Len(strFind)) > lngEnd) Then
'在范围之内
FindString = True
.SelStart = lngPos - 1
.SelLength = Len(strFind)
'如果“替换”值为空，仅仅只查找
If strReplace <> "" Then '替换它
.SelText = strReplace
End If
End If
End If
End With
End Function
'*************************************************
' 目的: 设置参数来调用函数来替换字符串
'*************************************************
Private Sub cmdReplace_Click()
Dim lngLen As Long '结束位置
Dim lngStart As Long '开始位置
'设置框内的文字的结尾长度
lngLen = Len(fMainForm.ActiveForm.rtfText.Text)
Select Case cbFindDirection.ListIndex
Case 0 '搜索全部
lngStart = 1
Case 1 '向后搜索
lngStart = 1
'设置当前选择的结尾
lngLen = fMainForm.ActiveForm.rtfText.SelStart
lngLen = lngLen + fMainForm.ActiveForm.rtfText.SelLength
Case 2 '向前搜索
'设置当前选择的开头
lngStart = fMainForm.ActiveForm.rtfText.SelStart
lngStart = lngStart + fMainForm.ActiveForm.rtfText.SelLength
End Select
'调用函数来替换
If Not FindString(cbFind.Text, cbReplace.Text, lngStart, lngLen) Then
MsgBox "未找到匹配字符串。", 0, "替换"
Else
Unload Me
End If
End Sub
'*************************************************
' 目的: 调用函数替换文字，并且调用它直到没有更多
' 的可替换的文字存在
'*************************************************
Private Sub cmdReplaceAll_Click()
Dim lngLen As Long '结束位置
Dim lngStart As Long '开始位置
Dim strMsg As String '提示的临时字符串
'建造警告提示
strMsg = "这个程序将从你的文档开头开始替换所"
strMsg = strMsg & " 有可替换的文字。是否继续？"
'提示用户是否确定
If MsgBox(strMsg, vbYesNo, "Are You Sure?") = vbYes Then
'用户确定，替换所有文字
Do
If lngStart = 0 Then
lngStart = 1
Else
'设置新的开始位置和结束位置
lngStart = fMainForm.ActiveForm.rtfText.SelStart
lngStart = lngStart + fMainForm.ActiveForm.rtfText.SelLength
End If
'设置文档的末尾
lngLen = Len(fMainForm.ActiveForm.rtfText.Text)
'循环直到替换完成
Loop While FindString(cbFind.Text, cbReplace.Text, lngStart, lngLen)
End If
' unload form
Unload Me
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Function IfExist(ByVal str As String) As Boolean
Dim i As Integer
For i = 1 To cbFind.ListCount
If (str = cbFind.List(i - 1)) Then
IfExist = True
Exit Function
End If
Next
IfExist = False
End Function
Private Sub Form_Load()
Dim i, count As Integer
Dim str As String
count = GetSetting(App.Title, "Settings1", "CbFindCount", CStr(cbFind.ListCount))
For i = 1 To count
str = GetSetting(App.Title, "Settings1", "CbFindList" + CStr(i), cbFind.List(i - 1))
cbFind.AddItem str
Next
'设置搜索方向为ALL
cbFindDirection.ListIndex = 0
With Line1
.BorderColor = &H808080
.x1 = 0
.y1 = 3300
.x2 = Me.ScaleWidth
.y2 = .y1
End With
With Line2
.BorderColor = vbWhite
.x1 = Line1.x1
.y1 = Line1.y1 + 20
.x2 = Line1.x2
.y2 = .y1
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
SaveSetting App.Title, "Settings1", "CbFindCount", cbFind.ListCount
For i = 1 To cbFind.ListCount
SaveSetting App.Title, "Settings1", "CbFindList" + CStr(i), cbFind.List(i - 1)
Next
End Sub
'*************************************************
' 目的: 使按钮有效或无效
'*************************************************
Private Sub cbFind_Change()
If Len(cbFind.Text) > 0 Then
'查找文字存在，使“查找下一个”按钮有效
cmdFindNext.Enabled = True
Else
'查找文字不存在，使“查找下一个”按钮无效
cmdFindNext.Enabled = False
End If
End Sub
'*************************************************
' 目的: 选择框中的所有内容
'*************************************************
Private Sub cbFind_GotFocus()
cbFind.SelStart = 0
cbFind.SelLength = Len(cbFind.Text)
End Sub
'*************************************************
' 目的: 使按钮有效或无效
'*************************************************
Private Sub cbReplace_Change()
If Len(cbReplace.Text) > 0 Then
'查找文字存在，使“查找下一个”按钮有效
cmdReplace.Enabled = True
CmdReplaceAll.Enabled = True
Else
'查找文字不存在，使“查找下一个”按钮无效
cmdReplace.Enabled = False
CmdReplaceAll.Enabled = False
End If
End Sub
'*************************************************
' 目的: 选择框中的所有内容
'*************************************************
Private Sub cbReplace_GotFocus()
cbReplace.SelStart = 0
cbReplace.SelLength = Len(cbReplace.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -