Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Find and Replace

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Find and Replace

    Code:
    'Find and Replace routines by Charles Dietz
    'Just need to add the last four functions to use in application.
    'Applies to textboxes and richedit.
    'This code is released into the Public Domain.
    
    'I have tried to improve the standard find and replace routines which I have seen before.
    'Searches and even replacements can be made in either direction. Cycle once can be used
    'to keep from repeated searching. When the replacement contains that which is to be
    'replaced, mistakes can be easily made. For example, say "assets" is to be replaced by
    '"my assets", this program will skip finding "assets" if it has already been replaced,
    'thus avoiding a possible mistake of replacing "assets" again.
    '-------------------------------------------------------------------------------------
    
    #COMPILE EXE                                                                            
    #DIM ALL                                        
    #INCLUDE "Win32api.inc"
    #Include "RichEdit.inc"                
    
    %IDM_Find     = 201                                          
    %IDM_FindNext = 202                                        
    %IDM_FindPrev = 203                                                                                          
    %IDM_Replace  = 204                              
    %IDC_Escape   = 205                                                                    
    %IDC_Text     = 100                                      
    
    FUNCTION PBMAIN()                                                        
       LOCAL hDlg, nStyle, fileNo AS LONG                                                            
       local ti, sText, ctrl as string
       DIALOG default FONT "arial", 10
       ti = "Find and Replace for "
       DIALOG NEW 0, "", , , 354, 250, %WS_SYSMENU TO hDlg
       fileNo = FREEFILE                                                  
       OPEN "testFile2.txt" FOR binary AS #fileNo                                                  
       sText = STRING$(LOF(fileNo), 0)
       GET #fileNo,, sText  'load file into string buffer                              
       CLOSE #fileNo
       ctrl = "textbox"
       'ctrl = "richedit"
       dialog set text hDlg, ti + ctrl                      
       nStyle = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoVScroll _
                Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
       if ctrl = "textbox" then
          CONTROL ADD TEXTBOX, hDlg, %IDC_Text, "", 0, 0, 350, 225, nStyle
          control set text hDlg, %IDC_Text, sText
       elseif ctrl = "richedit" then
          LoadLibrary("riched32.dll") : InitCommonControls
          Control Add "RichEdit", hDlg, %IDC_Text, "Try this", 0, 0, 350, 225, nStyle
          control send hDlg, %IDC_Text, %EM_ReplaceSel, 1, strptr(sText)
       end if          
       DIALOG SHOW MODAL hDlg CALL DialogProc
    END FUNCTION
    
    CALLBACK FUNCTION dialogProc()
    '   LOCAL hFont, j, k, n AS LONG
       local hFont, gOldProc as long
       STATIC hEdit AS DWORD
       SELECT CASE CBMSG                                          
          CASE %WM_INITDIALOG
             addMenubar CBHNDL                                                                      
             hFont = makeFont("Courier New", 10)
             IF hFont THEN
                 CONTROL SEND CBHNDL, %IDC_Text, %WM_SETFONT, hFont, 1
             END IF                                                            
             CONTROL HANDLE CBHNDL, %IDC_Text TO hEdit
             CONTROL SET FOCUS CBHNDL, %IDC_Text
             control send cb.hndl, %IDC_Text, %EM_SETSEL, -1, 0  
             control send cb.hndl, %IDC_Text, %EM_SETSEL, 0, 0
             ' Subclass the edit control
             sendmessage hEdit, %EM_SETSEL, -1, 0
             gOldProc = SetWindowLong(hEdit, %GWL_WNDPROC, CODEPTR(SubClassProc))
             dialog set user cbhndl, 1, gOldProc
             dialog post cbhndl, %WM_User + 500, 0, 0
          case %WM_USEr + 500
          CASE %WM_COMMAND
             SELECT CASE CBCTL                                                                        
                CASE %IDM_Find
                   myFindReplace(hEdit)              
                CASE %IDM_FindNext
                   myFindReplace(hEdit, 3)
                CASE %IDM_FindPrev                                                                                    
                   myFindReplace(hEdit, -3)
                CASE %IDM_Replace
                   myFindReplace(hEdit, 1)
             END SELECT
          CASE %WM_DESTROY
             ' Important! Remove the subclassing
             SetWindowLong hEdit, %GWL_WNDPROC, gOldProc
       END SELECT  
    END FUNCTION        
    
    FUNCTION SubClassProc(BYVAL hWnd&, BYVAL wMsg&, BYVAL wParm&, BYVAL lParm&) AS LONG
        'Process our messages in this subclass procedure
        local lRes as long
        static gOldProc as long
        dialog get user getParent(hWnd&), 1 to gOldProc                            
        SELECT CASE wMsg&                                
           CASE %WM_GETDLGCODE        
              ' TextBoxes has a tendency to select all text when they receive
              ' focus. We can change this behaviour by altering the return
              ' value from CallWindowProc under %WM_GETDLGCODE as follows:
              lRes = CallWindowProc (gOldProc, hWnd&, wMsg&, wParm&, lParm&)
              IF (lRes AND %DLGC_HASSETSEL) = %DLGC_HASSETSEL THEN  'lRes contains %DLGC_HASSETSEL
                 lRes = lRes XOR %DLGC_HASSETSEL                    'remove %DLGC_HASSETSEL from lRes
                 FUNCTION = lRes: EXIT FUNCTION                     'return the altered value and exit    
              END IF
        END SELECT
        ' Pass the message on to the original window procedure
        FUNCTION = CallWindowProc(gOldProc, hWnd&, wMsg&, wParm&, lParm&)
    END FUNCTION
    
    SUB addMenubar(hDlg AS LONG)                                                
       LOCAL hMenu, hSearchMenu, hAccel AS LONG
       MENU NEW BAR TO hMenu
       MENU NEW POPUP TO hSearchMenu
       MENU ADD STRING, hSearchMenu, "&Find" & $TAB & "Ctrl+F", %IDM_Find, %MF_ENABLED
       MENU ADD STRING, hSearchMenu, "Find &Next" & $TAB & "F3", %IDM_FindNext, %MF_ENABLED
       MENU ADD STRING, hSearchMenu, "Find &Previous" & $TAB & "Shft+F3", %IDM_FindPrev, %MF_ENABLED
       MENU ADD STRING, hSearchMenu, "&Replace" & $TAB & "Ctrl+R", %IDM_Replace, %MF_ENABLED
       MENU ADD POPUP, hMenu, "Search", hSearchMenu, %MF_ENABLED
       MENU ATTACH hMenu, hDlg
       REDIM ac(1 to 4) AS ACCELAPI
       ac(1).fvirt = %FVIRTKEY OR %FCONTROL
       ac(1).key = %VK_F
       ac(1).cmd =  %IDM_Find
       ac(2).fvirt = %FVIRTKEY
       ac(2).key = %VK_F3
       ac(2).cmd =  %IDM_FindNext
       ac(3).fvirt = %FVIRTKEY OR %FSHIFT
       ac(3).key = %VK_F3
       ac(3).cmd =  %IDM_FindPrev
       ac(4).fvirt = %FVIRTKEY OR %FCONTROL
       ac(4).key = %VK_R
       ac(4).cmd =  %IDM_Replace          
       ACCEL ATTACH hDlg, ac() TO hAccel
    END SUB
    
    FUNCTION MakeFont(xFont AS STRING, ptSize AS LONG) AS LONG
       LOCAL hdc, yRes AS LONG, charHt AS LONG
       hDC = GetDC(%HWND_DESKTOP)
       yRes  = GetDeviceCaps(hdc, %LOGPIXELSY)
       ReleaseDC %HWND_DESKTOP, hDC
       charHt = (PtSize * yRes) \ 72
       FUNCTION = CreateFont(-charHt, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                  %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                  %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY xFont)
    END FUNCTION
    
    '--------------------------------------------------------------------------------------------------
    '  Find and replace routines
    '--------------------------------------------------------------------------------------------------
    
    FUNCTION myFind(hText AS LONG, findTxt AS STRING, whole AS LONG, ncase AS LONG, ndir AS LONG) AS LONG
       'this function finds and returns the next position of the search string
       'hText   = handle of control holding the text to be searched
       'findTxt = string to be searched for                                              
       'whole, ncase, cycleOnce, ndir are options to be used
       '-------------------------------------------------------------------------------------
       LOCAL j, k, n, nPos, done AS LONG                                                                                  
       LOCAL sText, s1, s2 AS STRING                                                                              
    
       n = GetWindowTextLength(hText)+1: sText = SPACE$(n)                
       SendMessage hText, %WM_GETTEXT, n, STRPTR(sText)
       SendMessage hText, %EM_GETSEL, VARPTR(j), VARPTR(k)                      
       IF LEN(findTxt) = 0 THEN function = j + 1: exit function
       nPos = k + 1
       IF ndir < 0 THEN nPos = j - LEN(sText) - 1            
       DO 'until whole word is found
          IF ncase THEN                                    
             nPos = INSTR(nPos, sText, findTxt)                          'search matching case
          ELSE
             nPos = INSTR(nPos, lCASE$(sText), lCASE$(findTxt))          'search any case
          END IF
          done = 1
          IF whole AND nPos THEN                                         'must be whole word
             s1 = MID$(sText, nPos - 1, 1)                               'previous character
             s2 = MID$(sText, nPos + LEN(findTxt), 1)                    'next character
             IF (s1 >= "A" AND s1 <= "Z") OR (s1 >= "a" AND s1 <= "z") OR _        
                (s2 >= "A" AND s2 <= "Z") OR (s2 >= "a" AND s2 <= "z") OR _
                (s1 >= "0" AND s1 <= "9") OR (s2 >= "0" AND s2 <= "9") OR _
                s1 = "_" OR s2 = "_" THEN
                done = 0: nPos = nPos + ndir
                if ndir < 0 then nPos = -(LEN(sText) + 1 - nPos)
             END IF
          END IF
       LOOP UNTIL done
       FUNCTION = nPos
    END FUNCTION
    
    FUNCTION myFindReplace(hText AS LONG, opt byval nOpt AS LONG) AS LONG                                        
       'this function sets up the find and replace dialog window
       'it is also where all of the searching takes place
       'nOpt =  0  find dialog
       '     =  1  replace dialog                    
       '     =  3  find next
       '     = -3  find prev
       '
       'changed options in dialog box are remembered
       'pass parameters to callback with parms(7)
       'option to cycle between top and end of text
    '----------------------------------------------------------------------  
       LOCAL hFindRepl, j, k, n, nnPos AS LONG
       local s as string                                          
       STATIC nPos, whole, ncase, alreadyBeenHere as long
       static ndir, replaceDlg, zeroReset AS LONG
       static ti, sText, findTxt, lastFindTxt AS STRING                                        
       static parmsPtr as long ptr
       DIM parms(1 to 4) AS LONG: parmsPtr = VARPTR(parms(0))
       if alreadyBeenHere = 0 then 'first time through, set defaults                  
          alreadyBeenHere = 1: whole = 1: ncase = 0
       end if
       n = GetWindowTextLength(hText)+1: sText = SPACE$(n)
       SendMessage hText, %WM_GETTEXT, n, STRPTR(sText)                                                                    
       SendMessage hText, %EM_GETSEL, VARPTR(j), VARPTR(k)                                    
       findTxt = MID$(sText, j + 1, k - j): lastFindTxt = findTxt
       IF abs(nOpt) = 3 THEN 'find next
          ndir = sgn(nOpt): nnPos = nPos
          nPos = myFind(hText, findTxt, whole, ncase, ndir)
          if nPos = 0 then 'reset to top or end
             incr zeroReset                              
             if ndir < 0 then n = len(sText) else n = 0                                                                    
             SendMessage hText, %EM_SETSEL, n, n                                                                
             nPos = myFind(hText, findTxt, whole, ncase, ndir)
          end if
          DECR nPos
          SendMessage hText, %EM_SETSEL, nPos, nPos + LEN(findTxt)                                      
          SendMessage hText, %EM_SCROLLCARET, 0, 0                                                  
          EXIT FUNCTION                        
       ELSEIF nOpt = 1 THEN 'show replace dialog                    
          ti = "Replace": replaceDlg = 1: nPos = 0
       ELSEif nOpt = 0 then 'show find dialog                  
          ti = "Find": replaceDlg = 0
       END IF                                                        
       ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''                                        
       if replaceDlg then 'find and replace dialog
          DIALOG NEW getParent(hText), ti, , , 250, 110, %WS_SYSMENU TO hFindRepl
          CONTROL ADD LABEL, hFindRepl, -1, "&What:", 10, 10, 25, 10
          CONTROL ADD TEXTBOX, hFindRepl, 9700, "", 40, 10, 140, 12                            
          CONTROL ADD LABEL, hFindRepl, -1, "&With:", 10, 30, 25, 10
          CONTROL ADD TEXTBOX, hFindRepl, 9701, "", 40, 30, 140, 12                                
          CONTROL ADD CHECKBOX, hFindRepl, 9702, "&Match whole word only", 10, 49, 86, 10
          CONTROL ADD CHECKBOX, hFindRepl, 9703, "Match &case", 10, 62, 50, 10
          CONTROL ADD CHECKBOX, hFindRepl, 9706, "Cycle &once", 10, 75, 48, 10
          CONTROL ADD FRAME, hFindRepl, -1, "Direction", 120, 50, 60, 36
          CONTROL ADD OPTION, hFindRepl, 9704, "&Up", 125, 60, 40, 10
          CONTROL ADD OPTION, hFindRepl, 9705, "&Down", 125, 70, 40, 10
          CONTROL ADD BUTTON, hFindRepl, %IDOK, "&Find", 190, 5, 50, 20, %BS_DEFAULT 'or %bs_notify
          CONTROL ADD BUTTON, hFindRepl, 9708, "&Replace", 190, 27, 50, 20
          CONTROL ADD BUTTON, hFindRepl, 9709, "Replace &All", 190, 49, 50, 20                                        
          CONTROL ADD BUTTON, hFindRepl, %IDCANCEL, "Cancel", 190, 71, 50, 20                          
       else
          s = findTxt: if len(s) = 0 then s = lastFindTxt
          DIALOG NEW getParent(hText), ti, , , 250, 90, %WS_SYSMENU TO hFindRepl                                                                                          
          CONTROL ADD LABEL, hFindRepl, -1, "&What:", 10, 10, 25, 10
          CONTROL ADD TEXTBOX, hFindRepl, 9700, s, 40, 10, 140, 12                            
          CONTROL ADD CHECKBOX, hFindRepl, 9702, "&Match whole word", 10, 32, 86, 10
          CONTROL ADD CHECKBOX, hFindRepl, 9703, "Match &case", 10, 45, 50, 10
          CONTROL ADD CHECKBOX, hFindRepl, 9706, "Cycle &once", 10, 58, 48, 10
          CONTROL ADD FRAME, hFindRepl, -1, "Direction", 120, 30, 60, 36
          CONTROL ADD OPTION, hFindRepl, 9704, "&Up", 125, 40, 40, 10
          CONTROL ADD OPTION, hFindRepl, 9705, "&Down", 125, 50, 40, 10
          CONTROL ADD BUTTON, hFindRepl, %IDOK, "&Find", 190, 5, 50, 20, %BS_DEFAULT 'or %bs_notify                    
          CONTROL ADD BUTTON, hFindRepl, %IDCANCEL, "Cancel", 190, 45, 50, 20
       END IF                                                                                    
       @parmsPtr[1] = hText: @parmsPtr[2] = replaceDlg: @parmsPtr[3] = whole: @parmsPtr[4] = ncase                          
       DIALOG SET USER hFindRepl, 1, parmsPtr
       DIALOG SHOW modal hFindRepl CALL findReplaceProc
    END FUNCTION                                                                        
    
    CALLBACK FUNCTION findReplaceProc()                                                                      
       LOCAL j, k, m, n, nnPos, nPre, testForDone, selFlag AS LONG
       LOCAL s AS STRING
       STATIC hText, whole, ncase, cycleOnce, ndir as long
       static replaceDlg, beginLoc, zeroReset, nPos, found AS LONG
       static findTxt, replaceTxt, lastFindTxt, lastReplaceTxt, sText as string        
       STATIC parmsPtr AS LONG PTR                                                        
       SELECT CASE CBMSG                                                          
          CASE %WM_INITDIALOG                                                                
             DIALOG GET USER CBHNDL, 1 TO parmsPtr                                                        
             hText = @parmsPtr[1]: replaceDlg = @parmsPtr[2]: whole = @parmsPtr[3]: ncase = @parmsPtr[4]
             n = GetWindowTextLength(hText)+1: sText = SPACE$(n)
             SendMessage hText, %WM_GETTEXT, n, STRPTR(sText)    'text to search in
             SendMessage hText, %EM_GETSEL, VARPTR(j), VARPTR(k)
             beginLoc = j: zeroReset = 0
             findTxt = MID$(sText, j + 1, k - j)
             if j = k then control disable cbhndl, 9708
             if len(findtxt) = 0 then findTxt = lastFindTxt: selFlag = 1
             control send cbhndl, 9701, %EM_SETSEL, 0, -1                                      
             CONTROL SET TEXT CBHNDL, 9700, findTxt    'text to search for
             if selFlag then control post cbhndl, 9700, %EM_SETSEL, 0, -1
             if replaceDlg then
                if j = k then control disable cbhndl, 9708
                replaceTxt = lastReplaceTxt
                CONTROL SET TEXT CBHNDL, 9701, replaceTxt    
                control post cbhndl, 9701, %EM_SETSEL, 0, -1
                if len(findTxt) and selFlag = 0 then control set focus cbhndl, 9701                
             end if
             CONTROL sET CHECK CBHNDL, 9702, whole
             CONTROL sET CHECK CBHNDL, 9703, ncase                                    
             CONTROL sET CHECK CBHNDL, 9706, 0
             CONTROL SET OPTION cbhndl, 9705, 9704, 9705
          CASE %WM_COMMAND
             select case cbctl                          
                case %IDOK 'find next text
                   CONTROL GET TEXT CBHNDL, 9700 TO findTxt        
                   if len(findTxt) = 0 then
                      msgbox "Must enter something to find", %MB_iconerror, "Error"        
                      control set focus cbhndl, 9700: exit function                          
                   end if
                   lastFindTxt = findTxt
                   IF replaceDlg THEN 'replace dialog                                  
                      if cycleOnce then control disable cbhndl, 9704
                      if cycleOnce then control disable cbhndl, 9705
                      nnPos = nPos                                      
                      nPos = myFind(hText, findTxt, whole, ncase, ndir)
                      if nPos = 0 then 'reset to top or end
                         incr zeroReset
                         if ndir < 0 then n = len(sText) else n = 0                        
                         SendMessage hText, %EM_SETSEL, n, n                                                    
                         nPos = myFind(hText, findTxt, whole, ncase, ndir)  
                         if nPos = 0 then                                                                          
                            dialog end cbhndl
                            s = "none found"                                                          
                            if found then s = "No more to replace"    
                            beep: msgbox s, %mb_iconinformation, findTxt
                            SendMessage hText, %EM_SETSEL, nnPos, nnPos
                            SendMessage hText, %EM_SCROLLCARET, 0, 0                                                  
                            found = 0: lastReplaceTxt = ""
                            exit function        
                         end if  
                      end if
                      'check if findTxt is contained in replaceTxt and if replacement  
                      'has already been done here... and if so, move to the next
                      if tally(lcase$(replaceTxt), lcase$(findTxt)) and (len(findTxt) < len(replaceTxt)) then
                         nPre = instr(lcase$(replaceTxt), lcase$(findTxt)) - 1
                         if nPos > nPre and len(replaceTxt) then
                            s = mid$(sText, nPos - nPre, len(replaceTxt))
                            m = ncase and (s = replaceTxt)
                            n = (ncase = 0) and (lcase$(s) = lcase$(replaceTxt))
                            if m or n then                              
                               if ndir > 0 then nPos = nPos + len(findTxt) - 1
                               SendMessage hText, %EM_SETSEL, nPos, nPos
                               DIALOG SEND CBHNDL, %WM_COMMAND, %IDOK, 0
                               exit function
                            end if
                         end if
                      end if
                      'now check if cycle is complete
                      testForDone = zeroReset = 1 and (ndir*nPos > ndir*beginLoc)    
                      if (cycleOnce and (zeroReset = 2 or testForDone or (found and nPos = 0))) then
                         dialog end cbhndl                                                                      
                         beep: msgbox "Cycle is complete", %mb_iconinformation, "Replacing Text"
                         SendMessage hText, %EM_SETSEL, nnPos, nnPos
                         SendMessage hText, %EM_SCROLLCARET, 0, 0
                         found = 0: zeroReset = 0  
                         exit function
                      end if
                      DECR nPos: found = 1
                      SendMessage hText, %EM_SETSEL, nPos, nPos + LEN(findTxt)                                      
                      SendMessage hText, %EM_SCROLLCARET, 0, 0                                                  
                      control enable cbhndl, 9708
                      exit function
                   else 'find dialog
                      if cycleOnce then control disable cbhndl, 9704
                      if cycleOnce then control disable cbhndl, 9705
                      nnPos = nPos      
                      nPos = myFind(hText, findTxt, whole, ncase, ndir)
                      if nPos = 0 then 'reset to top or end and search from there
                         incr zeroReset
                         if ndir < 0 then n = len(sText) else n = 0
                         SendMessage hText, %EM_SETSEL, n, n                          
                         nPos = myFind(hText, findTxt, whole, ncase, ndir)            
                         if nPos = 0 then
                            dialog end cbhndl                                                
                            msgbox "None found", %mb_iconinformation, findTxt
                            exit function
                         end if
                      end if
                      testForDone = zeroReset = 1 and (ndir*nPos > ndir*beginLoc)  
                      if (cycleOnce and (zeroReset = 2 or testForDone)) then
                         dialog end cbhndl
                         beep: msgbox "Cycle is complete", %mb_iconinformation, "Replacing Text"
                         SendMessage hText, %EM_SETSEL, nnPos, nnPos
                         SendMessage hText, %EM_SCROLLCARET, 0, 0
                         zeroReset = 0
                         exit function                          
                      end if                                  
                      DECR nPos                                                                    
                      SendMessage hText, %EM_SETSEL, nPos, nPos + LEN(findTxt)                                      
                      SendMessage hText, %EM_SCROLLCARET, 0, 0
                   end if
                case 9702 'whole
                   CONTROL GET CHECK CBHNDL, cbctl TO whole
                case 9703 'ncase
                   CONTROL GET CHECK CBHNDL, cbctl TO ncase                                            
                case 9704, 9705 'search up/down
                   control get check cbhndl, 9705 to ndir  'search down
                   if ndir = 0 then ndir = -1  
                case 9706 'cycle once
                   if cbctlmsg = %bn_clicked then
                      control get check cbhndl, cbctl to cycleOnce                        
                      if cycleOnce then
                         SendMessage hText, %EM_GETSEL, VARPTR(j), VARPTR(k)
                         beginLoc = j: zeroReset = 0
                      end if
                   end if
                case 9708 'replace this one
                   SendMessage hText, %EM_GETSEL, VARPTR(j), VARPTR(k)
                   CONTROL GET TEXT CBHNDL, 9700 TO findTxt      'get text to replace
                   CONTROL GET TEXT CBHNDL, 9701 TO replaceTxt   'get replacement text                            
                   if len(replaceTxt) = 0 then
                      msgbox "Must enter a replacement", %MB_iconerror, "Error"
                      control set focus cbhndl, 9701: exit function                      
                   end if                                                                          
                   lastFindTxt = findTxt: lastReplaceTxt = replaceTxt
                   control send cbhndl, 9701, %BM_SETSTYLE, %BS_DEFPUSHBUTTON, 1
                   sText = LEFT$(sText, j) + replaceTxt + MID$(sText, k + 1)      
                   SendMessage hText, %WM_SETTEXT, 0, STRPTR(sText)
                   if tally(lcase$(replaceTxt), lcase$(findTxt)) and (len(findTxt) < len(replaceTxt)) then
                      m = unreplaced(hText, findTxt, replaceTxt, whole, ncase)
                      if m = 0 then 'no unreplaced remain
                         dialog end cbhndl
                         msgbox "... No more to replace", %MB_iconinformation, findTxt
                         SendMessage hText, %EM_SETSEL, nPos, nPos
                         SendMessage hText, %EM_SCROLLCARET, 0, 0
                         lastReplaceTxt = "": exit function
                      end if
                   end if
                   if ndir > 0 then n = j + LEN(replaceTxt) else n = j
                   SendMessage hText, %EM_SETSEL, n, n
                   DIALOG SEND CBHNDL, %WM_COMMAND, %IDOK, 0                                                  
                case 9709 'replace all of them
                   CONTROL GET TEXT CBHNDL, 9700 TO findTxt
                   CONTROL GET TEXT CBHNDL, 9701 TO replaceTxt
                   if len(findTxt) = 0 or len(replaceTxt) = 0 then
                      s = "Must enter something to find " + $crlf _
                        + "and something to replace it with"                              
                      msgbox s, %MB_iconerror, "Error"
                      if len(findTxt) = 0 then control set focus cbhndl, 9700: exit function
                      if len(replaceTxt) = 0 then control set focus cbhndl, 9701: exit function
                   end if
                   lastFindTxt = findTxt: lastReplaceTxt = replaceTxt
                   s = "Be carefull here" + $crlf + "Are you sure you want to replace all?"        
                   n = msgbox(s, %MB_ICONWARNING or %Mb_yesno, "Replacing text")
                   if n = %idno then function = 1: exit function                                                      
                   nPos = 0: ndir = 1                                                            
                   DO                                                                                                    
                      SendMessage hText, %EM_SETSEL, nPos, nPos
                      nPos = myFind(hText, findTxt, whole, ncase, ndir) - 1
                      SendMessage hText, %EM_SETSEL, nPos, nPos + LEN(findTxt)
                      incr nPos:
                      IF nPos THEN
                         SendMessage hText, %EM_ReplaceSel, 1, BYVAL STRPTR(replaceTxt)
                         nPos = nPos + len(replaceTxt): found = 1
                      END IF
                   LOOP WHILE nPos
                   DIALOG END CBHNDL: setFocus(hText)                                      
                   nPos = 0: SendMessage hText, %EM_SETSEL, nnPos, nnPos
                   if found then                                                      
                      msgbox "Done replacing text", %MB_iconinformation, findTxt
                   else                                                                              
                      msgbox "Nothing found to replace", %MB_iconerror, findTxt
                   end if
                case %IDCANCEL                              
                   DIALOG END CBHNDL
             end select                                                                  
          CASE %WM_SYSCOMMAND
             IF CBCTL = %SC_CLOSE THEN DIALOG END CBHNDL                                          
       END SELECT
    END FUNCTION
    
    function unreplaced(hText as long, findTxt as string, replaceTxt as string,_
                        whole as long, ncase as long) as long
       '-------------------------------------------------------------------------
       'scan text beginning to end, counting number of replacements remaining
       '-------------------------------------------------------------------------                
       local nPos, nPre, flag, n, k as long                
       local s, sText as string
       n = GetWindowTextLength(hText)+1: sText = SPACE$(n)                
       SendMessage hText, %WM_GETTEXT, n, STRPTR(sText)
       nPre = instr(lcase$(replaceTxt), lcase$(findTxt)) - 1
       SendMessage hText, %EM_SETSEL, 0, 0
       do
          nPos = myFind(hText, findTxt, whole, ncase, 1)
          if nPos > nPre and len(replaceTxt) then                                
             s = mid$(sText, nPos - nPre, len(replaceTxt))
             if ncase then
                if s <> replaceTxt then flag = 1: incr k
             else
                if lcase$(s) <> lcase$(replaceTxt) then flag = 1: incr k
             end if                                                                          
          end if
          if flag then n = nPos + len(findtxt) else n = nPos - nPre + len(replaceTxt)
          decr n: SendMessage hText, %EM_SETSEL, n, n
       loop until nPos = 0
       function = k                                                  
    end function

  • #2
    I use to know how to preserve indents, but I guess I've forgotten... I thought I just used [/code] at the top.
    I finally found a post on how to do it, so editing and saving it solved that problem.

    But I just realized that I don't know how to upload the text file, "testfile2.txt, that I used for testing. Of course the user can use his own file, but I was wanting to make it as convenient to the user as possible.

    Comment


    • #3
      Use [/code] without the slash at top of code and with slash at end. In menu, you have a button with # that can be used to wrap code in those tags. Edit and fix.

      Comment


      • #4
        Thanks, Borje. That was helpful... can you help with how to upload a test file. I clicked on the upload button, but nothing appeared to happen.

        Comment


        • #5
          Use "code" in square brackets instead of quotes at the top, "/code" in square brackets at the bottom. (The slash means "end".) Or use the # on the reply tool bar to create the code tags.

          Create the tags THEN paste in the source code. I've found sometimes the indentation is lost anyway if you put source code first, then add the tags around it.

          Cheers,

          (I know no comments here, but this is OP is most likely to see it.)

          added- sorry if it looks like I'm repeating Borje but had a power outage here while typing. Laptop has battery, but ADSL is mains powered. Power came back on, I finished and posted, then saw posts 3 and 4.
          Dale

          Comment


          • #6
            Been a while since I uploaded zip file with code, but as I recall it, one simply uses the "Upload Attachments" button below this edit field and the select desired file in one's own computer in the open file dialog box. Can't remember if one had to tick some box like "Store on server", but don't think so - it should just work anyway.

            Comment


            • #7
              Originally posted by Charles Dietz View Post
              Thanks, Borje. That was helpful... can you help with how to upload a test file. I clicked on the upload button, but nothing appeared to happen.
              Do you have "scripting" turned off in your browser, The Upload Attachments button needs to run javascript

              Comment


              • #8
                oops
                Dale

                Comment


                • #9
                  For convenience of the user, here is a zip file with two files: findReplace.bas and testfile2.txt
                  Thanks, everyone for helping me get back to posting on this new site, new to me, anyway.

                  findReplace.zip

                  Comment


                  • #10
                    I have made a couple of corrections and a few improvements to the version of "FindReplace.bas" above. This new version is FindReplace1.bas which is included in the following zip file.

                    findReplace1.zip

                    Comment

                    Working...
                    X