|
|
|
|
|
|
|
|
|
|
|
 |
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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 |
| Prerequisites | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 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.
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
'case-insensitive.
'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
FindReset
'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, _
"Find/Replace"
'reset the vars
FindReset
cboSearch.SetFocus
End If
End If
Case True
.bCountOnly = True
.sSearchText = cboSearch.Text
Call CountSearch
MsgBox .nNumFound & " matches found for ' " & _
.sSearchText & " '", _
vbInformation, "Find/Replace"
FindReset
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
Else
'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, _
LOWorkText)
'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
FindReset
End If 'success
End If 'frd.nCurrPos
End If 'cmdReplace(0).Caption
Case 1:
Screen.MousePointer = vbHourglass
ChangeAll
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"
Else
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, _
.bMatchCase)
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
Else
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
'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
Else
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)
Loop
'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
Else
'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
Else
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)
Loop
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...
'button
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"
Else
'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, _
frd.bMatchCase)
'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
Else
IsInstance = False
End If
End Function |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Comments | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 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. | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
 |
