在vb中设计与记事本一样的查找功能?
发布网友
发布时间：2024-10-17 04:46
共1个回答
热心网友
时间：2024-11-04 06:22
Public Function IsDelim(Char As String) As Boolean
Select Case Asc(Char)
Case 65 To 90, 95, 97 To 122
IsDelim = False
Case Else: IsDelim = True
End Select
End Function
Public Function Find_On(TxtBox As TextBox, Start As Integer, Txt As String, MatchCase As Boolean, WholeWord_Only As Boolean) As Integer
On Error GoTo Handle
Dim Pos, lBefore, lAfter As Integer
Dim fDelimLeft, fDelimRight As Boolean
If MatchCase = True Then
Pos = InStr(Start + 1, TxtBox, Txt)
Else
Pos = InStr(Start + 1, TxtBox, Txt, vbTextCompare)
End If
If Not Pos = 0 Then
fDelimLeft = True
fDelimRight = True
If WholeWord_Only = True Then
lBefore = Pos - 1
lAfter = Pos + Len(Txt)
If (lBefore > 0) Then
fDelimLeft = IsDelim(Mid$(TxtBox, lBefore, 1))
End If
If Not (lAfter > Len(TxtBox)) Then
fDelimRight = IsDelim(Mid$(TxtBox, lAfter, 1))
End If
End If
If (fDelimLeft And fDelimRight) Then
TxtBox.SetFocus
TxtBox.SelStart = Pos - 1
TxtBox.SelLength = Len(Txt)
Find_On = Pos + Len(Txt)
End If
Exit Function
End If
If Start = 1 Then
MsgBox "Search text '" & Txt & " ' not found", vbCritical, "Sorry"
Else
MsgBox "Search Completed For '" & Txt & " '", vbCritical, "Completed !"
End If
Exit Function
Handle:
MsgBox "Unexpected Error occured", vbCritical, "Sorry"
End Function Form中的代码如下：'说明
'text1为装载文本的文本框
'Text2为查找内容文本框
'txtReplace为替换内容的文本框
Option Explicit
Dim Position As IntegerPrivate Sub cmdReplace_Click() ' 替换
If Not Text1.SelLength = 0 Then
Text1.SelText = txtReplace
End If
Command1_Click
End SubPrivate Sub Command1_Click() '查找
Dim Match As Boolean, Whole As Boolean
If Check1.Value = 1 Then Match = True
If Check2.Value = 1 Then Whole = True
Position = Find_On(Text1, Position + 1, Text2, Match, Whole)
If Not Position = 0 Then Command1.Caption = "继续查找(&N)"
End SubPrivate Sub Text2_Change()
Position = -1
Command1.Caption = "查找"
End Sub 我帮你做的查找包括了区分大小写和全字匹配，分别对应check1和check2，还有不懂q上密我！
