Page 1 of 1

Default Richtext Find/Replace

Posted: Wed Jul 09, 2003 9:50 am
by LuckyLuke

Code: Select all

Global hFindReplace.l, uFindReplaceMsg.l
Global find.s, replace.s

Global frpl.FINDREPLACE
Global findtext.FINDTEXTEX

#FINDMSGSTRING = "commdlg_FindReplace"
#Editor = 0
#ST_DEFAULT = 0
#ST_KEEPUNDO = 1
#ST_SELECTION = 2

Structure SETTEXTEX
  flags.l
  codepage.l
EndStructure

; Should be initialized else dialog windows won't appear
find.s = ""
replace.s = ""

Procedure FindText()
  If hFindReplace= 0
    frpl\lStructSize = SizeOf(FINDREPLACE)
    frpl\hwndOwner = WindowID()
    frpl\hInstance = GetModuleHandle_(0)
    frpl\flags = #FR_DOWN 
    frpl\lpstrFindWhat = @find
    frpl\wFindWhatLen = 80  ; Miminum Length = 80
    hFindReplace = FindText_(frpl)
  EndIf
EndProcedure

Procedure ReplaceText()
  If hFindReplace= 0
    frpl\lStructSize = SizeOf(FINDREPLACE)
    frpl\hwndOwner = WindowID()
    frpl\hInstance = GetModuleHandle_(0)
    frpl\flags = #FR_DOWN 
    frpl\lpstrFindWhat = @find
    frpl\wFindWhatLen = 80
    frpl\lpstrReplaceWith = @replace    
    frpl\wReplaceWithLen = 80
    hFindReplace = ReplaceText_(frpl)
  EndIf
EndProcedure

Procedure.l WindowCallback(WindowID.l, Message.l, wParam.l, lParam.l) 

  Result = #PB_ProcessPureBasicEvents 

  If message = uFindReplaceMsg
    settext.SETTEXTEX
    *lpfr.FINDREPLACE    
    *lpfr = lParam
    
    flag = *lpfr\flags
    
    ;Check if dialog window is closed
    If flag & #FR_DIALOGTERM
      hFindReplace = 0
      ProcedureReturn 0
    EndIf    
    
    SetFocus_(GadgetID(#Editor))
    
    If flag & #FR_FINDNEXT
      uFlags = uFlags | #FR_FINDNEXT
    EndIf
    If flag & #FR_REPLACE
      uFlags = uFlags | #FR_REPLACE
    EndIf
    If flag & #FR_REPLACEALL
      uFlags = uFlags | #FR_REPLACEALL
    EndIf  
    If flag & #FR_DOWN
      uFlags = uFlags | #FR_DOWN
    EndIf
    If flag & #FR_MATCHCASE
      uFlags = uFlags | #FR_MATCHCASE
    EndIf
    If flag & #FR_WHOLEWORD
      uFlags = uFlags | #FR_WHOLEWORD
    EndIf    

    what$ = PeekS(*lpfr\lpstrFindWhat)    
    findtext\lpstrText = @what$
    
    If uFlags & #FR_FINDNEXT
       SendMessage_(GadgetID(#Editor),#EM_EXGETSEL,0,@findtext\chrg)
                  
       If (findtext\chrg\cpMin <> findtext\chrg\cpMax And uFlags & #FR_DOWN) Or (uFlags & #FR_DOWN)
          findtext\chrg\cpMin = findtext\chrg\cpMax
          findtext\chrg\cpMax = -1
       Else 
         findtext\chrg\cpMax = 0 
       EndIf

       c = SendMessage_(GadgetID(#Editor),#EM_FINDTEXT, uFlags, findtext) 
       If c <> -1 
          findtext\chrgText\cpMin = c
          findtext\chrgText\cpMax = c + Len(what$)      
          SendMessage_(GadgetID(#Editor),#EM_EXSETSEL, 0, findtext\chrgText) 
       Else
         MessageRequester("Information","Cannot find " + what$, #PB_MessageRequester_Ok)  
       EndIf
    ElseIf uFlags & #FR_REPLACEALL 
       replace$ = PeekS(*lpfr\lpstrReplaceWith)
       findtext\chrg\cpMin = 0
       findtext\chrg\cpMax = -1
       
       settext\flags = #ST_SELECTION
       settext\codepage = #CP_ACP
       a = 0
       While a = 0
         c = SendMessage_(GadgetID(#Editor), #EM_FINDTEXTEX, uFlags, findtext)
         If c = -1
           a=1
         Else  
           SendMessage_(GadgetID(#Editor), #EM_EXSETSEL, 0, findtext\chrgText)
           SendMessage_(GadgetID(#Editor), #EM_SETTEXTEX, settext, @Replace$)
           findtext\chrg\cpMin = c + Len(replace$)
         EndIf
       Wend
    Else
       replace$ = PeekS(*lpfr\lpstrReplaceWith)
       SendMessage_(GadgetID(#Editor),#EM_EXGETSEL,0,@findtext\chrg)
           
       If (findtext\chrg\cpMin <> findtext\chrg\cpMax And uFlags & #FR_DOWN) Or (uFlags & #FR_DOWN)
          findtext\chrg\cpMin = findtext\chrg\cpMax
          findtext\chrg\cpMax = -1
       Else 
         findtext\chrg\cpMax = 0 
       EndIf 
       
       settext\flags = #ST_SELECTION
       settext\codepage = #CP_ACP

       c = SendMessage_(GadgetID(#Editor), #EM_FINDTEXTEX, uFlags, findtext)
       If c <> -1
         SendMessage_(GadgetID(#Editor), #EM_EXSETSEL, 0, findtext\chrgText)
         SendMessage_(GadgetID(#Editor), #EM_SETTEXTEX, settext, @Replace$)
       Else
         MessageRequester("Information","Cannot find " + what$, #PB_MessageRequester_Ok)  
       EndIf
    EndIf
  EndIf
  
  ProcedureReturn Result 

EndProcedure 

Procedure StreamFileInCallback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn ReadFile_(hFile, pbBuff, cb, pcb, 0)!1 
EndProcedure 

Procedure loadFile(pFilePath.s) 
  If ReadFile(0, pFilePath) 
    If GetExtensionPart(pFilePath)="rtf" 
      uFormat = #SF_RTF 
    Else 
      uFormat = #SF_TEXT 
    EndIf 
    edstr.EDITSTREAM 
    edstr\dwCookie = UseFile(0) 
    edstr\dwError = 0 
    edstr\pfnCallback = @StreamFileInCallback() 
    SendMessage_(GadgetID(#Editor), #EM_STREAMIN, uFormat, edstr) 
    CloseFile(0) 
  Else 
    MessageRequester("Error", "Error Occured While Opening File", #PB_MessageRequester_Ok) 
  EndIf 
EndProcedure 

If OpenWindow(0, 200, 50, 640, 400, #PB_Window_SystemMenu,"RichText Find/Replace")=0:End:EndIf 


If CreateMenu(0, WindowID())=0:End:EndIf 
  MenuTitle("&File") 
    MenuItem(0, "&Open") 
    MenuItem(1, "&Find...") 
    MenuItem(2, "&Replace...") 
    MenuItem(3, "&Quit") 
If CreateGadgetList(WindowID())=0:End:EndIf 
EditorGadget(#Editor, 0, 0, WindowWidth(), WindowHeight()) 

; message identifier for FINDMSGSTRING 
uFindReplaceMsg = RegisterWindowMessage_(#FINDMSGSTRING) 

SetWindowCallback(@WindowCallback()) 


Repeat 
  EventID = WaitWindowEvent() 
  If EventID=#PB_EventMenu 
    Select EventMenuID() 
      Case 0 
        FileName$ = OpenFileRequester("", "", "All files|*.*", 0) 
        If FileName$ 
          loadFile(FileName$) 
        EndIf 
      Case 1 
         FindText()
      Case 2
         ReplaceText()
      Case 3
        Quit = 1 
    EndSelect 
  ElseIf EventID=#PB_Event_CloseWindow 
    Quit = 1 
  EndIf 
Until Quit 
End
Any comments/optimisations are welcome ...

Posted: Wed Jul 09, 2003 1:02 pm
by RJP Computing
Thank you. This looks great.