Find/Replace procedure

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Find/Replace procedure

Post by utopiomania »

Code updated for 5.20+

Just finished this and thought I should share it with you in case you need something like it in one of your projects :)

The demo is a bit clunky, but I've just plugged the procedure into a program of my own, and it works as expected so far.

Let me hear it if you experience ANY kind of dislikesor problems with it!

Code: Select all

Procedure findReplace(id)
  flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
  win = OpenWindow(#PB_Any, 0, 0, 400, 145, "Find/Replace", flags)
  If win
    StickyWindow(win, #True)
    ;draw the find icon       
    img1 = CreateImage(#PB_Any, 22, 22)
    If StartDrawing(ImageOutput(img1))
      Box(0, 0, 24, 24, GetSysColor_(15))
      ;icon index 176, 55
      ExtractIconEx_("shell32.dll", 176, 0, @icon, 1)
      If icon
        DrawImage(icon, 0, 0, 21, 21)
        DestroyIcon_(icon)
      EndIf
      StopDrawing()
    EndIf
    If 1
      ImageGadget(#PB_Any, 10, 15, 0, 0, ImageID(img1))
      TextGadget(#PB_Any, 40, 20, 75, 22, "Find:")
    Else
      TextGadget(#PB_Any, 10, 20, 75, 22, "Find What:")
    EndIf
    str1 = StringGadget(#PB_Any, 100, 15, 200, 21, "")
    TextGadget(#PB_Any, 10, 50, 75, 22, "Replace With:")
    str2 = StringGadget(#PB_Any, 100, 45, 200, 21, "")
    btn1 = ButtonGadget(#PB_Any, 310, 15, 80, 22, "Find Next", #PB_Button_Default)
    DisableGadget(btn1, #True)
    btn2 = ButtonGadget(#PB_Any, 310, 45, 80, 22, "Replace")
    DisableGadget(btn2, #True)
    btn3 = ButtonGadget(#PB_Any, 310, 80, 80, 22, "Replace all")
    DisableGadget(btn3, #True)
    btn4 = ButtonGadget(#PB_Any, 310, 110, 80, 22, "Cancel")
    
    ;get any selected text in the richedit
    SendMessage_(GadgetID(id), #EM_EXGETSEL, 0, @text.FINDTEXT\chrg)
    If (text\chrg\cpMin <> text\chrg\cpMax)
      ;selected text range found, check it's length
      len = text\chrg\cpMax - text\chrg\cpMin
      If len <= 128
        char.c
        *txt = AllocateMemory((len + 1) * SizeOf(char))
        ;get the selected text
        SendMessage_(GadgetID(id), #EM_GETSELTEXT, 0, *txt)
        SetGadgetText(str1, PeekS(*txt))
        FreeMemory(*txt)
        ;focus the replace input field
        SetActiveGadget(str2)
        ;enable the buttons
        DisableGadget(btn1, #False)
        DisableGadget(btn2, #False)
        DisableGadget(btn3, #False)
      EndIf
    Else
      ;focus the findstring input field
      SetActiveGadget(str1)
    EndIf
    
    chk1 = CheckBoxGadget(#PB_Any, 10, 80, 120, 22, "Match Case")
    chk2 = CheckBoxGadget(#PB_Any, 10, 112, 120, 22, "Whole Words only")
    chk3 = CheckBoxGadget(#PB_Any, 140, 112, 160, 22, "Search From Top")
    
    ;no text found yet:
    pos = -1
    ;default search flag
    flg | #FR_DOWN
    
    Repeat
      event = WaitWindowEvent()
      If EventWindow() = win
        Select event
          Case #PB_Event_Gadget
            Select EventGadget()
              Case str1
                ;find string
                GadgetToolTip(str1, GetGadgetText(str1))
                If Len(GetGadgetText(str1))
                  DisableGadget(btn1, #False)
                  DisableGadget(btn2, #False)
                  DisableGadget(btn3, #False)
                Else
                  DisableGadget(btn1, #True)
                  DisableGadget(btn2, #True)
                  DisableGadget(btn3, #True)
                EndIf
                
              Case str2
                ;replace string
                GadgetToolTip(str2, GetGadgetText(str2))
                
              Case btn1
                ;find button
                find.s = GetGadgetText(str1)
                text.FINDTEXT\lpstrText = @find
                ;get current position or selected range in the text
                SendMessage_(GadgetID(id), #EM_EXGETSEL, 0, @text\chrg)
                If (text\chrg\cpMin <> text\chrg\cpMax)
                  ;selected text range found, search from the end of it
                  text\chrg\cpMin = text\chrg\cpMax
                EndIf
                If GetGadgetState(chk3)
                  ;reset, search from the top
                  SetGadgetState(chk3, 0)
                  text\chrg\cpMin = 0
                EndIf
                ;search to the end of the text:
                text\chrg\cpMax = -1
                ;set the search flags
                flg = 0
                flg | #FR_DOWN
                If GetGadgetState(chk1)
                  flg | #FR_MATCHCASE
                EndIf
                If GetGadgetState(chk2)
                  flg | #FR_WHOLEWORD
                EndIf
                pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                If pos <> -1
                  ;found, select the text range
                  SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                Else
                  msg.s = "Cannot find " + find + Chr(13) + Chr(10)
                  msg + "Search again from the top ?"
                  flags = #MB_ICONQUESTION | #MB_YESNOCANCEL
                  Select MessageRequester("Find/Replace", msg, flags)
                    Case #IDYES
                      ;first position in the text
                      SendMessage_(GadgetID(id), #EM_SETSEL, 0, 0)
                      text\chrg\cpMin = 0
                      ;search to the end of the text:
                      text\chrg\cpMax = -1
                      pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                      If pos <> -1
                        ;found, select the text range
                        SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                      Else
                        msg.s = "Cannot find " + find
                        flags = #MB_ICONINFORMATION | #MB_OKCANCEL
                        Select MessageRequester("Find/Replace", msg, flags)
                          Case #IDCANCEL
                            Break
                        EndSelect
                      EndIf
                      SetActiveGadget(id)
                    Case #IDCANCEL
                      Break
                  EndSelect
                EndIf
                
              Case btn2
                ;replace button
                ;get selected range in the text
                SendMessage_(GadgetID(id), #EM_EXGETSEL, 0, @text\chrg)
                If (text\chrg\cpMin <> text\chrg\cpMax)
                  ;found selected text range
                  repl.s = GetGadgetText(str2)
                  If text\chrg\cpMax - text\chrg\cpMin = Len(GetGadgetText(str1))
                    ;same length as the find string, replace it
                    SendMessage_(GadgetID(id), #EM_REPLACESEL, 1, @repl)
                    ;advance the current position
                    text\chrg\cpMin + Len(repl)
                  EndIf
                Else
                  ;no selection made yet, search from the current position
                  text\chrg\cpMin = text\chrg\cpMax
                EndIf
                If GetGadgetState(chk3)
                  ;reset, search from the top
                  SetGadgetState(chk3, 0)
                  text\chrg\cpMin = 0
                EndIf
                ;search to the end of the text:
                text\chrg\cpMax = -1
                find.s = GetGadgetText(str1)
                text\lpstrText = @find
                ;set the search flags
                flg = 0
                flg | #FR_DOWN
                If GetGadgetState(chk1)
                  flg | #FR_MATCHCASE
                EndIf
                If GetGadgetState(chk2)
                  flg | #FR_WHOLEWORD
                EndIf
                pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                If pos <> -1
                  ;found, select the text range
                  SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                Else
                  msg.s = "Cannot find " + find + Chr(13) + Chr(10)
                  msg + "Search again from the top ?"
                  flags = #MB_ICONQUESTION | #MB_YESNOCANCEL
                  Select MessageRequester("Find/Replace", msg, flags)
                    Case #IDYES
                      ;first position in the text
                      SendMessage_(GadgetID(id), #EM_SETSEL, 0, 0)
                      text\chrg\cpMin = 0
                      ;search to the end of the text:
                      text\chrg\cpMax = -1
                      pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                      If pos <> -1
                        ;found, select the text range
                        SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                      Else
                        msg.s = "Cannot find " + find
                        flags = #MB_ICONINFORMATION | #MB_OKCANCEL
                        Select MessageRequester("Find/Replace", msg, flags)
                          Case #IDCANCEL
                            Break
                        EndSelect
                      EndIf
                    Case #IDCANCEL
                      Break
                  EndSelect
                EndIf
                
              Case btn3
                ;replace all button
                Repeat
                  ;get selected range in the text
                  SendMessage_(GadgetID(id), #EM_EXGETSEL, 0, @text\chrg)
                  If (text\chrg\cpMin <> text\chrg\cpMax)
                    ;found selected text range
                    repl.s = GetGadgetText(str2)
                    If text\chrg\cpMax - text\chrg\cpMin = Len(GetGadgetText(str1))
                      ;same length as the find string, replace it
                      SendMessage_(GadgetID(id), #EM_REPLACESEL, 1, @repl)
                      ;advance the current position
                      text\chrg\cpMin + Len(repl)
                    EndIf
                  Else
                    ;no selection made yet, search from the current position
                    text\chrg\cpMin = text\chrg\cpMax
                  EndIf
                  If GetGadgetState(chk3)
                    ;reset, search from the top
                    SetGadgetState(chk3, 0)
                    text\chrg\cpMin = 0
                  EndIf
                  ;search to the end of the text:
                  text\chrg\cpMax = -1
                  find.s = GetGadgetText(str1)
                  text\lpstrText = @find
                  ;set the search flags
                  flg = 0
                  flg | #FR_DOWN
                  If GetGadgetState(chk1)
                    flg | #FR_MATCHCASE
                  EndIf
                  If GetGadgetState(chk2)
                    flg | #FR_WHOLEWORD
                  EndIf
                  pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                  If pos <> -1
                    ;found, select the text range
                    SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                  EndIf
                Until pos = -1
                
                msg.s = "Cannot find " + find + Chr(13) + Chr(10)
                msg + "Search again from the top ?"
                flags = #MB_ICONQUESTION | #MB_YESNOCANCEL
                Select MessageRequester("Find/Replace", msg, flags)
                  Case #IDYES
                    ;first position in the text
                    SendMessage_(GadgetID(id), #EM_SETSEL, 0, 0)
                    text\chrg\cpMin = 0
                    ;search to the end of the text:
                    text\chrg\cpMax = -1
                    pos = SendMessage_(GadgetID(id), #EM_FINDTEXT, flg, @text)
                    If pos <> -1
                      ;found, select the text range
                      SendMessage_(GadgetID(id), #EM_SETSEL, pos, pos + Len(find))
                    Else
                      msg.s = "Cannot find " + find
                      flags = #MB_ICONINFORMATION | #MB_OKCANCEL
                      Select MessageRequester("Find/Replace", msg, flags)
                        Case #IDCANCEL
                          Break
                      EndSelect
                    EndIf
                  Case #IDCANCEL
                    Break
                EndSelect
                
              Case btn4
                ;cancel button
                Break
            EndSelect
          Case #PB_Event_CloseWindow
            Break
        EndSelect
      EndIf
    ForEver
    CloseWindow(win)
  EndIf
EndProcedure

;demo
flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
win = OpenWindow(#PB_Any, 0, 0, 600, 400, "", flags)
edt1 = EditorGadget(#PB_Any, 0, 0, 600, 400)
For i = 0 To 40
  AddGadgetItem(edt1, i, "Editor gadget line " + Str(i))
Next
SendMessage_(GadgetID(edt1), #EM_SETSEL, 0, 0)

findReplace(edt1)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver
Last edited by utopiomania on Tue Jan 23, 2007 9:53 am, edited 6 times in total.
Top
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Re: Find/Replace procedure

Post by PB »

I get a "gadget object not initialized" error for line 225 if the debugger is on.
@Fred/Freak: Does this mean a compiled exe would be prone to crashing?

@utopiomania: You do know there's a small API call that does this too, yeah?
I'll try to make a working example and post it here. Never had need to before,
but it would make your app look more professional due to using the Windows
API Common Dialog version.

Edit: Here's an example in Visual Basic on how to call it:
http://www.freevbcode.com/ShowCode.asp?ID=3304
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

Was an error in the demo code, hope it works now. As for the API, I replaced it with this because the API code
alternative I found needed a callback, and was virtually unreadable, so I dreamt up this in (almost) pure Basic
instead :)

EDIT: and, BTW it was designed to look like the Windows common dialog version too.To make your apps look
more professional. :wink:
Top
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Post by PB »

> BTW it was designed to look like the Windows common dialog version
> too. To make your apps look more professional. :wink:

I didn't mean your version looked unprofessional: I just used the wrong word,
I actually meant to say "standard", as in the standard dialog expected by users.
Sorry for any offense!
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

No problems at all :) and many thanks for taking the time to check it out.
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

Just posted a slightly updated version. It now starts the 'search again from the top' correctly and
displays a dialog if it can't find more occurences of the search string.

I've also added a small icon to it. The code for this part is a few lines only, and easy to remove.
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

Just managed to make my code some 25 lines longer. Those lines fetch text that are selected in the richedit
when you call the procedure (if < 129 bytes) and put in in the 'find' field, then focus the 'replace' field.
Can make easier to use.
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

And corrected a potential problem: freeMemory(txt) --> freeMemory(*txt)
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Nice code.

Thanks for posting. I may well have a use for something like this.

cheers
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

Your'e welcome!

Please note that the code is updatet to work reliable with unicode executables.

There was an error with not allocating enough memory for unicode strings. This is
now fixed and the new code posted above.
Top
Post Reply

Return to “Tricks 'n' Tips”