module1.bas

实现系统的文字查找功能 程序短小 精悍 可以在你自己编写的字处理程序中实用

Attribute VB_Name = "Module1"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/10/30
'描  述：基于TextBoxes的查找并替换功能
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
'****************************
'By     Jim Jose
'email  [e-mail]
'****************************
'Thanks to Rde :-)

'PLEASE READ THIS
'It is made to get useful for anyone without 'much' changes.
'If you feel So
'   Please Rate this code
'Else
'   Give  feedback to improve  my code
'End If
'Good luck
'****************************
Option Explicit
Public Function IsDelim(Char As String) As Boolean
    Select Case Asc(Char) ' Upper/Lowercase letters,Underscore Not delimiters
    Case 65 To 90, 95, 97 To 122
        IsDelim = False
    Case Else: IsDelim = True ' Another Character Is delimiter
    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) ' useful when want To'FindNext'
        End If
        Exit Function
    End If
        If Start = 1 Then   'The search is just started
            MsgBox "Search text '" & Txt & " ' not found", vbCritical, "Sorry"
        Else    'Already have a search result
            MsgBox "Search Completed For '" & Txt & " '", vbCritical, "Completed !"
        End If
    Exit Function
Handle:
    MsgBox "Unexpected Error occured", vbCritical, "Sorry"
End Function