如何对一个RICHTEXTBOX进行查找和替换的程序？支持中文和英文！原代码？一定给分！

Question

在网上有许多代码，我试过但是不成功。

Answer 1

如何寻找并加亮找到的字符？If KeyCode = vbKeyF3 Then 'F3查找下一个
'下面这个If块在查找下一个匹配字符时很有用
If txtContext.SelStart = 0 Then '光标位置在文本框最开头
If txtContext.SelLength > 0 Then
nPos = 2 '如果文本框中有被加亮的字符
Else
nPos = 1 ''如果文本框中没有被加亮的字符
End If
Else
If txtContext.SelLength > 0 Then
nPos = txtContext.SelStart + 2 '如果文本框中有被加亮的字符
Else
nPos = txtContext.SelStart + 1 '如果文本框中没有被加亮的字符
End If
End If
nPos = InStr(nPos, txtContext.Text, FrmSearch.txtSearch.Text, vbTextCompare)
If nPos = 0 Then Exit Sub 'nPos=0表示没有找到
'加亮找到的字符串
txtContext.SelStart = nPos - 1
txtContext.SelLength = Len(FrmSearch.txtSearch.Text)
如何匹配TextBox框的查找下一个功能？If KeyCode = vbKeyF3 Then 'F3查找下一个
'下面这个If块在查找下一个匹配字符时很有用
If txtContext.SelStart = 0 Then '光标位置在文本框最开头
If txtContext.SelLength > 0 Then
nPos = 2 '如果文本框中有被加亮的字符
Else
nPos = 1 ''如果文本框中没有被加亮的字符
End If
Else
If txtContext.SelLength > 0 Then
nPos = txtContext.SelStart + 2 '如果文本框中有被加亮的字符
Else
nPos = txtContext.SelStart + 1 '如果文本框中没有被加亮的字符
End If
End If
nPos = InStr(nPos, txtContext.Text, FrmSearch.txtSearch.Text, vbTextCompare)
If nPos = 0 Then Exit Sub 'nPos=0表示没有找到
'加亮找到的字符串
txtContext.SelStart = nPos - 1
txtContext.SelLength = Len(FrmSearch.txtSearch.Text)

Answer 2

http://www.mvps.org/vbnet/index.html?code/project/findreplace.htm想要什么效果都有

Answer 3

回复人： Amoon(阿木) ( ) 信誉：100  2001-12-4 2:03:43  得分:0 
 
 
  
代码是抄的MSDN上的，做了点点改动。哈哈...我怕真的壮烈了，就不能来回答问题了。'===============| 窗体的代码 |=============
Private Sub Form_Load()
    gHTxtWnd = RichTextBox1.hwnd
End SubPrivate Sub mnuFind_Click()
    Dim szFindString As String  ' 要查找的字符串
    Dim hCmdBtn As Long         ' 对话框上的"查找下一个"按钮的句柄
    Dim strArr() As Byte        ' API使用的动态字节数组
    Dim i As Integer            ' 循环变量
    
    '初始化要查找的字符串
    szFindString = "Find Me"
    
    '根据字符串长度重新定义数组
    ReDim strArr(0 To Len(szFindString) - 1)
    
    '将字符串中的字符的ASCII码存入数组
    For i = 1 To Len(szFindString)
        strArr(i - 1) = Asc(Mid(szFindString, i, 1))
    Next i    '初始化结构 frText
    With frText
        .lpfnHook = 0&
        .lpTemplateName = 0&
        .lStructSize = Len(frText)
        .hwndOwner = Me.hwnd
        .hInstance = App.hInstance
        .lpstrFindWhat = VarPtr(strArr(0))
        .lpstrReplaceWith = 0&
        .wFindWhatLen = Len(szFindString)
        .wReplaceWithLen = 0
        .lCustData = 0
    End With    '显示查找对话框
    gHDlg = FindText(frText)
    
    '取得"查找下一个"按钮的窗口句柄
    hCmdBtn = GetDlgItem(gHDlg, 1)
    
    '取得"查找下一个"按钮原来的窗口函数地址
    gOldDlgWndHandle = GetWindowLong(hCmdBtn, GWL_WNDPROC)
    
    '用FindTextHookProc函数替换"查找下一个"按钮原来的窗口函数(即子类化"查找下一个"按钮)
    If SetWindowLong(hCmdBtn, GWL_WNDPROC, AddressOf FindTextHookProc) = 0 Then
       gOldDlgWndHandle = 0
    End If
End SubPrivate Sub mnuReplace_Click()
    msgbox "呵呵，就照着查找自己写些吧。"
End Sub'获得要被查找的字符串
Private Sub RichTextBox1_Change()
    gTxtSrc = RichTextBox1.Text
End Sub'=========| 模块的代码 |==========
Option ExplicitPublic Type FINDREPLACE
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        flags As Long
        lpstrFindWhat As Long
        lpstrReplaceWith As Long
        wFindWhatLen As Integer
        wReplaceWithLen As Integer
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As Long
End TypePublic Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA" (pFindreplace As FINDREPLACE) As Long
Public Declare Function ReplaceText Lib "comdlg32.dll" Alias "ReplaceTextA" _
(pFindreplace As FINDREPLACE) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function IsDlgButtonChecked Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long) As Long
Public Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_LBUTTONDOWN = &H201Public Const FR_DIALOGTERM = &H40
Public Const FR_DOWN = &H1
Public Const FR_ENABLEHOOK = &H100
Public Const FR_ENABLETEMPLATE = &H200
Public Const FR_ENABLETEMPLATEHANDLE = &H2000
Public Const FR_FINDNEXT = &H8
Public Const FR_HIDEMATCHCASE = &H8000
Public Const FR_HIDEUPDOWN = &H4000
Public Const FR_HIDEWHOLEWORD = &H10000
Public Const FR_MATCHCASE = &H4
Public Const FR_NOMATCHCASE = &H800
Public Const FR_NOUPDOWN = &H400
Public Const FR_NOWHOLEWORD = &H1000
Public Const FR_REPLACE = &H10
Public Const FR_REPLACEALL = &H20
Public Const FR_SHOWHELP = &H80
Public Const FR_WHOLEWORD = &H2Public Const EM_SETSEL = &HB1Public Const MaxPatternLen = 50   ' Maximum Pattern LengthGlobal gOldDlgWndHandle As Long
Global frText As FINDREPLACE
Global gTxtSrc As String
Global gHDlg As Long
Global gHTxtWnd As LongFunction FindTextHookProc(ByVal hDlg As Long, ByVal uMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As LongDim strPtn As String    ' pattern string
Dim hTxtBox As Long     ' handle of the text box in dialog box
Dim ptnLen As Integer   ' actual length read by GetWindowString
Dim sp As Integer       ' start point of matching string
Dim ep As Integer       ' end point of matchiing string
Dim ret As Long         ' return value for SendMessagestrPtn = Space(MaxPatternLen)    Select Case uMsg
        Case WM_LBUTTONDOWN
             ' Get the pattern string
             ptnLen = GetDlgItemText(gHDlg, &H480, strPtn, MaxPatternLen)
            
             ' Call default window procedure
             If gOldDlgWndHandle <> 0 Then
                 FindTextHookProc = CallWindowProc(gOldDlgWndHandle, _
                    hDlg, uMsg, wParam, lParam)
             End If
             
             ' Customize the winodw procedure
             If ptnLen <> 0 Then
                 strPtn = Left(strPtn, ptnLen)
                 SetFocus gHTxtWnd
                 
                 ' Get the MatchCase option
                 If IsDlgButtonChecked(gHDlg, &H411) = 0 Then
                     sp = InStr(LCase(gTxtSrc), LCase(strPtn))
                 Else
                     sp = InStr(gTxtSrc, strPtn)
                 End If
                 
                 sp = IIf(sp = 0, -1, sp - 1)
                 
                 If sp = -1 Then
                     Call MessageNoFound
                 End If
                 
                 ep = Len(strPtn)
                 ret = SendMessage(gHTxtWnd, EM_SETSEL, sp, sp + ep)
             End If
                
        Case Else
            ' Call the default window procedure
            If gOldDlgWndHandle <> 0 Then
               FindTextHookProc = CallWindowProc(gOldDlgWndHandle, _
                  hDlg, uMsg, wParam, lParam)
            End If
    End Select
End FunctionSub MessageNoFound()
    MsgBox "呵呵，不要开玩笑啦，根本就没有嘛！"
End Sub