frmreplace.frm

vb学习

VERSION 5.00
Begin VB.Form frmReplace 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "替换"
   ClientHeight    =   2160
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5115
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2160
   ScaleWidth      =   5115
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3480
      TabIndex        =   6
      Top             =   1440
      Width           =   1335
   End
   Begin VB.CommandButton cmdAll 
      Caption         =   "全部替换[&A]"
      Height          =   375
      Left            =   3480
      TabIndex        =   5
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "开始[&S]"
      Default         =   -1  'True
      Height          =   375
      Left            =   3480
      TabIndex        =   4
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox txtReplace 
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Top             =   1320
      Width           =   3015
   End
   Begin VB.TextBox txtFind 
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   3015
   End
   Begin VB.Label Label2 
      Caption         =   "替换为"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   1080
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "查找"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   1335
   End
End
Attribute VB_Name = "frmReplace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub ReplaceAll()
    Dim L1, L2, L3, Count As Long
    
    With MDIForm1.ActiveForm.RichTextBox1
        '利用API获得当前插入点位置
        SendMessageByRef .hwnd, EM_GETSEL, L1, L2
        L3 = L2
        While .Find(txtFind.Text, L2) > -1
            .SelText = strReplace
            '将查找位置移到替换完成的文本后面
            L2 = L2 + LenB(StrConv(strReplace, vbUnicode))
            Count = Count + 1
            DoEvents
        Wend
        
        '将查找位置移动到文本开头。
        L2 = 0
        While ((.Find(txtFind.Text, L2) > -1) And (L2 < L3))
            .SelText = strReplace
            L2 = L2 + LenB(StrConv(strReplace, vbUnicode))
            Count = Count + 1
            DoEvents
        Wend
    End With
    MsgBox "共执行" & Str(Count) & "个替换"
End Sub

Private Sub cmdAll_Click()
    If txtFind.Text = "" Then
        Beep
        txtFind.SetFocus
        Exit Sub
    End If
    strReplace = txtReplace.Text
    ReplaceAll
    MDIForm1.ActiveForm.FindStr = txtFind.Text
    Me.Hide
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
End Sub

Private Sub cmdStart_Click()
    If txtFind.Text = "" Then
        Beep
        txtFind.SetFocus
        Exit Sub
    End If
    
    strReplace = txtReplace.Text
    MDIForm1.ActiveForm.FindStr = txtFind.Text
    MDIForm1.FindStrRTF MDIForm1.ActiveForm.RichTextBox1
    If MDIForm1.ActiveForm.RichTextBox1.SelText = "" Then
        Exit Sub
    End If
    Me.Hide
    frmFR.Show 0
End Sub