vb6 select 字符串中的整个单词

Question

我正在尝试不使用正则表达式来搜索字符串，这可能是个坏主意！

搜索是针对 RichText 框中的文本字符串进行的
如果我搜索“是”，字符串中的第一个词是“This”
“This”的最后两个字母以 vbRed
突出显示要搜索的字符串还有另外两个“is”出现，并且按预期找到并突出显示

请问如何防止找到“This”中的“is”？

Private Sub btnSearch_Click()

Dim pos As Integer
Dim strToFind As String
Dim Y As Integer
Dim Ask As String

pos = 1
strToFind = tbSearch.Text

Do
    strToFind = tbSearch.Text
    pos = InStr(1, strToSearch, strToFind)
    
    For Y = 1 To Len(strToSearch)
       
    Ask = MsgBox("Yes Next Occurrence or No To Exit ?", vbYesNo, "Question")
    
    If Ask = vbYes Then
    lbOne.AddItem pos
    tbAns.Text = pos

        If pos = 0 Then
            Exit Sub
        End If
        
    rtbOne.SelStart = pos - 1
    rtbOne.SelLength = Len(strToFind)
    rtbOne.SelColor = vbRed
    
    pos = InStr(pos + 1, strToSearch, strToFind)
        
    Else
    
    tbAns.Text = "NO"
    pos = InStr(pos + 1, strToSearch, strToFind)
    tbAns.Text = pos
    Exit Sub
    End If

    Next

    Loop Until pos > 0
End Sub

Private Sub Form_Load()

    strToSearch = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
    
    rtbOne.Text = strToSearch
    tbSearch.Text = "is"

End Sub

如果这不可能，关于如何使用正则表达式的一些建议
我知道这么多我需要添加参考，这可能是
模式 myRegExp.Pattern = "(.)\strToFind\b(.)"

Answer 1

您可能会发现以下基于 VBScript.RegExp 的 InStrAll 实施很有用。

Option Explicit

Private Sub Form_Load()
    Const STR_TEXT      As String = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
    Dim vElem           As Variant
    
    For Each vElem In InStrAll(STR_TEXT, "is")
        Debug.Print vElem, Mid$(STR_TEXT, vElem, 2)
    Next
End Sub

Public Function InStrAll(sText As String, sSearch As String, Optional ByVal Compare As VbCompareMethod = vbTextCompare) As Variant
    Dim lIdx            As Long
    Dim vRetVal         As Variant
    
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = (Compare <> vbBinaryCompare)
        .Pattern = "[.*+?^${}()/|[\]\]"
        .Pattern = "\b" & .Replace(sSearch, "$&") & "\b"
        With .Execute(sText)
            If .Count = 0 Then
                vRetVal = Array()
            ElseIf .Count = 1 Then
                vRetVal = Array(.Item(0).FirstIndex + 1)
            Else
                ReDim vRetVal(0 To .Count - 1) As Variant
                For lIdx = 0 To .Count - 1
                    vRetVal(lIdx) = .Item(lIdx).FirstIndex + 1
                Next
            End If
        End With
    End With
    InStrAll = vRetVal
End Function

重点是首先你必须转义搜索到的字符串（在所有正则表达式控制符号前加上反斜杠）然后用 \bs 包装这个转义模式，然后再执行“全局”搜索所有匹配项。

InStrAll函数returns原始文本中的索引数组。在您选择的 RichTextBox 控件中实现实际的颜色编码突出显示取决于您。（如果我有选择的话，我会设置背景颜色，而不是找到的片段的前景。请注意大多数浏览器如何使用黄色背景来突出显示搜索结果。）

Answer 2

对于非 Regex 方法，请尝试以下方法：

Option Explicit

Private Sub Form_Load()
   RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
                       "search it is it a case sensative Search" & vbCr & vbCr & _
                       "is and is and is"
End Sub

Private Sub Command1_Click()
   Dim SearchTerm As String
   Dim SearchIndex As Integer
   
   SearchTerm = "is"
   SearchIndex = 1
   
   Do
      SearchIndex = InStr(SearchIndex, RichTextBox1.Text, SearchTerm)
      
      If isMatch(SearchIndex, SearchTerm) Then
         RichTextBox1.SelStart = SearchIndex - 1
         RichTextBox1.SelLength = Len(SearchTerm)
         RichTextBox1.SelColor = vbRed
      End If
      
      If SearchIndex > 0 Then SearchIndex = SearchIndex + Len(SearchTerm)
   Loop Until SearchIndex = 0
End Sub

Private Function isMatch(ByVal SearchIndex As Long, ByVal SearchTerm As String) As Boolean
   If SearchIndex = 1 Then
      If Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
   ElseIf SearchIndex + Len(SearchTerm) >= Len(RichTextBox1.Text) Then
      If Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Then isMatch = True
   ElseIf SearchIndex > 1 Then
      If (Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Or Mid(RichTextBox1.Text, SearchIndex - 1, 1) = vbCr) And Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
   End If
End Function

如评论中所述，原始代码存在局限性。该代码现在支持文本开头和结尾的匹配以及嵌入的分隔符。您可能需要向 isMatch 方法添加更多检查。

Answer 3

TOM FindText 接受 tomMatchWord 标志。就用那个。不要搞砸了从控件中提取文本，然后使用像 RegEx 这样的慢速脚本语言拐杖来咀嚼它。

Answer 4

我对 Bob77 和 Mark 所建议的“内置”搜索的想法很感兴趣，所以我将代码放在一起来实现这个想法。该代码使用 WinAPI 调用，但总体上非常简单，支持向前和向后移动以及切换区分大小写和整个单词：

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)

Private Enum Direction
   Forward = 1
   Backward = -1
End Enum

Private Doc As ITextDocument

Private Sub Form_Load()
   RichTextBox1.HideSelection = False
   RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
                       "search it is it a case sensative Search" & vbCr & vbCr & _
                       "is and IS and is"
   
   SearchTerm.Text = "is"

   Dim Unknown As IUnknown
   SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, Unknown
   Set Doc = Unknown
End Sub

Private Sub cmdForward_Click()
   Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Forward
End Sub

Private Sub cmdBack_Click()
   Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Backward
End Sub

Private Sub Match(ByVal SearchTerm As String, ByVal WholeWords As Integer, ByVal CaseSensitive As Integer, ByVal Direction As Direction)
   Dim Flags As Long
   Flags = 2 * WholeWords + 4 * CaseSensitive
   Doc.Selection.FindText SearchTerm, Direction * Doc.Selection.StoryLength, Flags
End Sub

您需要使用项目|参考中的“浏览...”按钮添加对 RICHED20.dll 的引用。

vb6 select 字符串中的整个单词

vb6 select whole word in string

regex

vb6

richtextbox