Visual Basic Projects

Pure VB: Create a Find and Replace Dialog
Step 2: Building the Find/Replace Form
Posted:   Monday August 05, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   Original: VB3/Win 3.1. Updated: VB6/Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
 Other project pages:   Step 1: Create the Find / Replace Dialog project
Project and code created from Step 1: Create the Find / Replace Dialog project

Once again, the layout form below shows the names of the respective controls you must add to the actual Find/Replace form, and their relative positions on that form. Controls in gold are required, but that do not have any code attached in this demo - that functionality is left for you to implement. The second cropped form below is provided for your convenience, and can be loaded to your working form's Picture property to provide a rough layout guide.

This page contains only the code for the form shown below. The file and calling form created in Step 1 are also required for the complete demo.








 BAS Code
None.  The project used the bas module created in Step 1.

 Form Code: dlgReplace - the Find / Replace form
Due to the complexity of this form, some controls use names other than the VB default controls names. I recommend you add the image above to the dialog's Picture property to assist in code layout, since the code to position the controls, as coded, moves the controls to fixed (absolute) positions. Note as well the project is coded for small fonts so large font users will need to adjust the code in order for the controls to line up correctly. This step was taken simply to minimize the UI code shown in order to concentrate on the actual Find/Replace code in the dialog.

The find/replace dialog's form should contain the following controls, each named as indicated. Note some controls are part of control arrays, so for correct functionality ensure their index property is set as shown.  The 'red' items below are required on the form in order for the repositioning code to work, but they do not have supporting code - that is your project.

Control   Name   Caption

Label   Label1(0)   &Find What:
Label   Label1(1)   Replace &With:
Label   Label1(2)   &Direction:
Frame   Frame1   Search
Combo   cboSearch   -
Combo   cboReplace   -
Combo   cboDir   -
Checkbox   chkFindWhole   Find Whole Word &Only
Checkbox   chkMatchCase   &Match Case
Checkbox   chkCountOnly   Count Matches Only
Option button   optSearch(0)   &Current Window
Option button   optSearch(1)   &All Windows
Option button   optSearch(2)   Selected &Text
Option button   optSearch(3)   (Your choice)
Command button   cmdFind   Find &Next
Command button   cmdCancel   Cancel
Command button   cmdReplace(0)   &Replace
Command button   cmdReplace(1)   Replace &All
Command button   cmdHelp   &Help

Save this form as dlgReplace, and add the following code to the form:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
'var holding a reference to
'the textbox being searched
Dim ctlTarget As Control

'LengthOf variables...
'search string
Dim LOSearch As Long

'replace string
Dim LOReplace As Long

'the text passed
'for search/replace
Dim LOWorkText As Long

'the instance of the
'search string found
Dim LOInstance As Long
'couple of form-level variables
'to track current word positions.
Dim pStop As Long
Dim pStart As Long

Private Sub Form_Load()

   Dim success As Boolean
   cboDir.ListIndex = 0
   optSearch(0).Value = True
   cboSearch.Text = ""
   cboReplace.Text = ""
   With frd
      If Len(.sSearchText) > 0 Then
         cboSearch.Text = .sSearchText
      End If
      .nCurrPos = IIf(ctlTarget.SelStart = 0, 1, ctlTarget.SelStart)
      .nCursorPos = .nCurrPos
     'When using the InStr function with
     'the compare parameter, a value of 0
     'indicates a binary search (AKA case ,
     'sensitive while a value of 1 indicates

     'Since the form is appearing from an
     'unloaded state, and the "Match Case"
     'checkbox value is not set via properties
     'or code, the expression below always
     'starts with a case-insensitive search.
     '(Check.value = 0, which is true (-1), the
     'ABS() of which is 1, or case insensitive)
      .bMatchCase = Abs(chkMatchCase.Value = 0)
     'before going further, determine if
     'there's reason to actually search!
      Call FindReplaceInit
      cboReplace.Text = .sReplaceText
   End With
End Sub

Private Sub Form_Unload(Cancel As Integer)

  'reset vars
  'we want to be sure to also
  'release the variables associated
  'with this form
   Set dlgReplace = Nothing

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

  'let Escape cancel the dialog
   If KeyAscii = 27 Then Unload Me
End Sub

Private Sub cmdCancel_Click()

   Unload Me
End Sub

Private Sub cmdFind_Click()

   With frd
      Select Case .bCountOnly
         Case False

            .sSearchText = cboSearch.Text
            LOReplace = Len(.sReplaceText)
            LOSearch = Len(.sSearchText)
           'attempt to find a match
            If .nCurrPos > 0 Then
               If pStop >= .nCurrPos Then .nCurrPos = pStop
              'pass the above, find an instance,
              'and set the remaining variables
               If Not vFindInstance(.nCurrPos, pStop) Then
                  MsgBox "The specified region has " & _
                         "been searched. Matches found: " & _
                         .nNumFound, vbInformation, _
                 'reset the vars
               End If
            End If
         Case True
            .bCountOnly = True
            .sSearchText = cboSearch.Text
            Call CountSearch
            MsgBox .nNumFound & " matches found for ' " & _
                   .sSearchText & " '", _
                   vbInformation, "Find/Replace"
      End Select
   End With

End Sub

Private Sub cmdReplace_Click(Index As Integer)

   Dim success As Long

  'we're about to replace text!
   frd.bInReplaceMode = True
  'a couple of initial steps
   frd.sSearchText = cboSearch.Text
   frd.sReplaceText = cboReplace.Text
   LOReplace = Len(frd.sReplaceText)
   LOSearch = Len(frd.sSearchText)
   Select Case Index
      Case 0
        'if the Find dialog is currently
        'showing, the button caption will
        'contain "Replace...". If so and
        'clicked, just change to the Replace
        'dialog format.
         If cmdReplace(0).Caption = "   Replace..." Then
            cmdReplace(0).Caption = "Replace"
           'don't have to pass the
           'optional values as they've
           'already been set!!!
            SetupInit swReplaceText
           'making sure there is text
           'in the buffer, attempt to
           'find a match
            If frd.nCurrPos > 0 Then
              'look for the first instance
              'of the search word
               If vFindInstance(frd.nCurrPos, pStop) Then
                 'must be one, so change it
                  Call vChangeInstance(pStart, _
                                       pStop, _
                                       LOInstance, _
                                       LOSearch, _
                                       LOReplace, _
                 'a little error prevention
                  If pStop >= frd.nCurrPos Then frd.nCurrPos = pStop
                 'See if another instance exists.
                 'If not, the 'done' message will
                 'be shown
                  success = vFindInstance(frd.nCurrPos, pStop)
               End If  'vFindInstance
              'when success is false, there
              'are/were no (more) instances
               If Not success Then
                  MsgBox "The document has been searched. " & _
                          frd.nNumFound & " matches found; " & _
                          frd.nNumReplaced & " changes made.", _
                          vbInformation Or vbOKOnly, "Find/Replace"
                 'reset the vars
               End If  'success
            End If  'frd.nCurrPos
         End If  'cmdReplace(0).Caption

   Case 1:
      Screen.MousePointer = vbHourglass
      Screen.MousePointer = vbDefault
      MsgBox "The document has been searched. " & _
              frd.nNumReplaced & " changes made.", _
              vbInformation Or vbOKOnly, "Find/Replace"

   End Select
   frd.bInReplaceMode = False
End Sub

Private Sub cboReplace_Change()

   cmdReplace(0).Enabled = Len(cboReplace.Text) > 0
   cmdReplace(1).Enabled = Len(cboReplace.Text) > 0
End Sub

Private Sub cboSearch_Change()

   cmdFind.Enabled = Len(cboSearch.Text) > 0
End Sub

Private Sub chkMatchCase_Click()

  'Using the InStr function, a value of 0
  'indicates a binary search (aka match case),
  'while a value of 1 indicates case-insensitive.
  'This is easily set via a checkbox by the
  'expression below.
  'Setting bMatchCase here, rather on
  'initializing the search, allows
  'the case-sensitivity to be toggled
  'while a search is in progress.
  'This equation seem backwards but
  'its setting bMatchCase to the same
  'values represented by the InStr
  'constants vbBinaryCompare and vbTextCompare.
  'When chkMatchCase.value = 1 (checked)
  'the expression (chkMatchCase.Value = 0)
  'evaluates to False. Abs(False) is 0,
  'and since 0 is the same value as the
  'InStr constant vbBinaryCompare, a
  'case sensitive search is performed.
  'When chkMatchCase.value = 0 (unchecked)
  'the expression (chkMatchCase.Value = 0)
  'evaluates to True. Abs(True) is 1,
  'and 1 is the same value as the
  'InStr constant vbTextCompare, thus a
  'case insensitive search is performed.
   frd.bMatchCase = Abs(chkMatchCase.Value = 0)

End Sub

Private Sub chkCountOnly_Click()

   frd.bCountOnly = chkCountOnly.Value = 1
   cboReplace.Enabled = frd.bCountOnly = False
   cmdReplace(0).Enabled = (frd.bCountOnly = False) And (Len(cboReplace) > 0)
   cmdReplace(0).Enabled = cmdReplace(0).Caption = "   Replace..."
   cmdReplace(1).Enabled = (frd.bCountOnly = False) And (Len(cboReplace) > 0)
   If frd.bCountOnly Then
     'reset the counter to 0 because
     'the routine always starts counting
     'from the beginning
      frd.nNumFound = 0
      cmdFind.Caption = "Count"
      cmdFind.Caption = "Find &Next"
   End If
End Sub

Private Function vFindInstance(currPos As Long, _
                               pStop As Long) As Boolean

   With frd
      If currPos = 0 Then currPos = 1
     'if there is an in-string match...
      If InStr(currPos, _
               .sWorkText, _
               .sSearchText, _
               .bMatchCase) > 0 Then
        'sWorkText constantly changes depending
        'on action replace results, so needs to
        'be referenced each call
         LOWorkText = Len(.sWorkText)
        'find the postitions of the instance
         pStart = InStr(currPos, _
                        .sWorkText, _
                        .sSearchText, _
         pStop = pStart + Len(.sSearchText)
        'highlight the text located text
         ctlTarget.SelStart = pStart - 1
         ctlTarget.SelLength = Len(.sSearchText)
        'increment FRD.nNumFound and return true
         If Not .bInReplaceMode Then
            .nNumFound = .nNumFound + 1
            vFindInstance = .nNumFound > 0
            vFindInstance = True
         End If  'If Not FRD.bInReplaceMode
         Exit Function
      End If  'If InStr
      vFindInstance = False
   End With
End Function

Private Function vChangeInstance(pStart, _
                                 pStop, _
                                 LOInstance, _
                                 LOSearch, _
                                 LOReplace, _
                                 LOWorkText) As Long

   With frd
      If InStr(.nCurrPos, _
               .sWorkText, _
               .sSearchText, _
               .bMatchCase) > 0 Then
         .nNumFound = .nNumFound + 1
         If LOInstance = LOReplace Then
           'if the LOInstance = LOreplace (same size),
           'then do simple replace; the text
           'length won't change here
            ctlTarget.SelText = .sReplaceText
            .nCurrPos = ctlTarget.SelStart + LOReplace
            .sWorkText = ctlTarget.Text
            .nNumReplaced = frd.nNumReplaced + 1
           'else the search and replace
           'strings are different lengths,
           'so replace and calculate the
           'new end-of-cursor position
            .nCurrPos = ((ctlTarget.SelStart + _
                          ctlTarget.SelLength) - LOSearch) _
                          + LOReplace
            ctlTarget.SelText = .sReplaceText
            LOWorkText = LOWorkText + LOReplace
            .sWorkText = ctlTarget.Text
            .nNumReplaced = .nNumReplaced + 1
         End If
         vChangeInstance = .nNumReplaced > 0
         vChangeInstance = False
      End If
   End With
End Function

Private Sub FindReplaceInit()
  'save the current textbox to
  'a working variable
   With frd
      .sWorkText = ctlTarget.Text
     'determine if there is at least
     '1 instance before starting
      If InStr(1, .sWorkText, .sSearchText, .bMatchCase) > 0 Then
         'yep, so assign the search string
         'and current cursor position
         .nCurrPos = IIf(.bStartAtTop, 1, .nCursorPos)
      End If
   End With

End Sub

Private Function ChangeAll() As Long
   Dim currPos As Long
   Dim strSize As Long

   With frd
      currPos = InStr(1, .sWorkText, .sSearchText, .bMatchCase)
      strSize = Len(.sWorkText)
      .nNumReplaced = 0

     'do the actual work
     'starting with the current cursor position
     'found above (the first match found in
     'the textbox), change and find the next etc...
      Do Until (currPos >= strSize) Or (currPos = 0)
         Call ChangeNext(.sWorkText, currPos, strSize)

     'Done. If changes were made,
     'assign the new text to the textbox
      If .nNumReplaced Then ctlTarget.Text = .sWorkText

      ChangeAll = frd.nNumReplaced
   End With

End Function

Private Function ChangeNext(msg As String, _
                            currPos As Long, _
                            strSize As Long) As String

  'function called repeatedly by
  'ChangeAll that locates each
  'matching string in turn
   Dim l As String
   Dim r As String

  'is there one?
   If InStr(currPos, msg, frd.sSearchText, frd.bMatchCase) > 0 Then
     'length of (LO) text
      LOReplace = Len(frd.sReplaceText)
      LOSearch = Len(frd.sSearchText)
      LOWorkText = Len(msg)

     'positions of instance
      pStart = InStr(currPos, msg, frd.sSearchText, frd.bMatchCase)
      pStop = pStart + Len(frd.sSearchText)

     'end of instance (length of instance)
      LOInstance = pStop - pStart

     'if the search and replace strings
     'are the same size, just do simple
     'mid$ insert
      If LOInstance = LOReplace Then
         Mid$(msg, pStart) = frd.sReplaceText
         currPos = pStop
         frd.nNumReplaced = frd.nNumReplaced + 1
        'have to else split up the
        'string to perform an insert
        'l = string up to instance
        'r = string after instance
         l = Left$(msg, pStart - 1)
         r = Mid$(msg, pStop, LOWorkText)
         msg = l & frd.sReplaceText & r
         currPos = Len(l) + LOReplace + 1
         strSize = strSize + LOReplace
         frd.nNumReplaced = frd.nNumReplaced + 1
      End If
      currPos = strSize
   End If
   ChangeNext = msg

End Function

Private Sub FindReset()

  'reset the search type variables
  'so as not to confuse the next call
   With frd
      .nCurrPos = 1
      .bCountOnly = chkCountOnly.Value = 1
      .nCursorPos = 0
      .bMatchCase = Abs(chkMatchCase.Value = 0)
      .bStartAtTop = True
      .nNumFound = 0
      .nNumReplaced = 0
   End With
   pStop = 0
End Sub

Private Function CountSearch() As Long

   With frd
     'save the current textbox to
     'a working variable
      .sWorkText = ctlTarget.Text
     'determine if there is at least
     'one instance before starting
      .nCurrPos = InStr(1, .sWorkText, .sSearchText, .bMatchCase)
      If .nCurrPos > 0 Then
        'only returns Boolean true or false;
        'count is kept in FRD.nNumFound
         Do While IsInstance(.nCurrPos)
      End If
      CountSearch = .nNumFound

   End With
End Function

Public Sub SetupInit(bReplaceDialog As Boolean, _
                     Optional ctl As Control, _
                     Optional frmParent As Form)

  'optional to allow this routine
  'to be called from the Replace...
   If ctlTarget Is Nothing Then
      Set ctlTarget = ctl
   End If

  'if bReplaceDialog is True, show as
  'a Replace dialog by revealing
  'appropriate controls
   If bReplaceDialog Then
      cmdReplace(0).Caption = "Replace"
      cmdReplace(1).Visible = True
      chkCountOnly.Top = 1950
      chkMatchCase.Top = 1680
      chkFindWhole.Top = 1410
      cmdHelp.Top = 1950
      cboDir.Top = 960
      Frame1.Top = 860
      Label1(2).Top = 1020
      Label1(1).Visible = True
      Label1(2).Visible = True
      cboReplace.Visible = True
      dlgReplace.Height = 2820
      Me.Caption = "Replace Text"
     'hide controls not required
     'for a Find
      cmdReplace(0).Caption = "   Replace..."
      cmdReplace(0).Enabled = True
      cmdReplace(1).Visible = True
      Label1(1).Visible = False
      Label1(2).Visible = True
      cboReplace.Visible = False
      Frame1.Top = 495
      cboDir.Top = 525
      cmdHelp.Top = 1530
      Label1(2).Top = 590
      chkFindWhole.Top = 945
      chkMatchCase.Top = chkFindWhole.Top + 30 + chkFindWhole.Height
      chkCountOnly.Top = chkMatchCase.Top + 30 + (chkMatchCase.Height)
      dlgReplace.Height = 2460
      Me.Caption = "Find Text"
   End If
  'once the form is correctly sized,
  'it can be centered.
   If Not frmParent Is Nothing Then
      CentreFormInParent Me, frmParent
   End If
End Sub

Private Function IsInstance(currPos As Long) As Boolean

  'given the tracked cursor position,
  'determines if, within the work text,
  'an instance of the string occurs
   Dim pos As Long
  'is there an instance of the
  'search word?
   pos = InStr(currPos, _
               frd.sWorkText, _
               frd.sSearchText, _
  'if so,
   If pos Then
     'increment the currPos start
     'counter to the position following
     'the match
      currPos = pos + Len(frd.sSearchText)
     'increment counter and return true
      frd.nNumFound = frd.nNumFound + 1
      IsInstance = True
      Exit Function
      IsInstance = False
  End If

End Function

Change the filename specified in Form1's Load sub (the calling form) to any valid text file on your machine, then save the project and run.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter