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 Common Dialog Boxes in Rich Edit Control

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

  • Find and Replace Common Dialog Boxes in Rich Edit Control

    ' find and replace common dialog boxes in rich edit control
    '
    ' if comments please post them in this link:
    ' http://www.powerbasic.com/support/pb...ad.php?t=11740
    '
    ' this special version can be used in a rich edit control. the format of
    ' the text is preserved. thanks to bud meyer for the inspiration.
    '
    ' many thanks also to borje hagsten and marty francom for highly inspiring code,
    ' which i have used in this program.
    '
    ' best regards,
    '
    ' erik christensen ------- april 19, 2005
    '
    ' august 29, 2005: unimportant small change made.
    Code:
    #compile exe
    #register none
    #dim all
    '
    #include "win32api.inc"
    #include "comdlg32.inc"
    #include "richedit.inc"
    '
    %textbox1           = 100
    %buttonfind         = 105
    %buttonreplace      = 110
    %buttonexit         = 115
    '
    global hform1&
    global msgfindreplace as long
    global hdlgmodeless as long
    global gpos as long, gptr as long, gtxt as string
    '
    '
    function openfindorreplacetextdialog (byval hwnd as long, byval ind as long, byval flgs as long) as long
        static fr as findreplace, ztxt as asciiz * 256, ztxt2 as asciiz * 256
        '
        ' the dialog remembers the find-string and replace-string between calls.
        ' there is no need to set them here.
        '
        fr.lstructsize      = sizeof(fr)
        fr.hwndowner        = hwnd
        fr.hinstance        = %null
        ' first time set flags to downward search direction - else to previous values.
        if istrue flgs then fr.flags = flgs else fr.flags = %fr_down or %fr_hideupdown ' this method only allows downward search
        fr.lpstrfindwhat    = varptr(ztxt)
        fr.wfindwhatlen     = sizeof(ztxt)
        fr.lpstrreplacewith = varptr(ztxt2)
        fr.wreplacewithlen  = sizeof(ztxt2)
        fr.lcustdata        = 0
        fr.lpfnhook         = %null
        fr.lptemplatename   = %null
        '
        if ind = 1 then function = findtext(fr)
        if ind = 2 then function = replacetext(fr)
        '
    end function
    '
    '
    function dofindreplaceaction(byval llparam as long,byval hwnd as long, byval id as long, byref flgs as long) as long
        static txt as string
        static ipos as long
        static match as long
        static przt as string
        static lppfr as findreplace ptr
        static zt as asciiz ptr, zt2 as asciiz ptr
        local cr as charrange
        local tf as textrange
        local buf as string
        local textmax&, searchflag&, res&                  '
        lppfr = llparam
        if (@lppfr.flags and %fr_dialogterm) then     ' find or replace dialog is closed
            hdlgmodeless = %null : function = 0 : exit function
        end if
        '
        flgs = @lppfr.flags                           ' save flags for next call
        zt = @lppfr.lpstrfindwhat                     ' text to search for
        zt2 = @lppfr.lpstrreplacewith                 ' replacing text if any
        '
        ' determine flags for specification of search
        searchflag& = 0
        if (@lppfr.flags and %fr_matchcase) then searchflag& = searchflag& or %fr_matchcase
        if (@lppfr.flags and %fr_wholeword) then searchflag& = searchflag& or %fr_wholeword
        '
        ' find caret or selection, if any
        control send hwnd, id,%em_exgetsel,0,varptr(cr)
        '
        if (@lppfr.flags and %fr_findnext) then ' find next
            gosub positioncheck  : gosub search
            if isfalse match then msgbox "no match found",%mb_iconinformation, "find"
        elseif (@lppfr.flags and %fr_replace) then ' replace
            gosub search
            if istrue match then
                control send hwnd, id, %em_replacesel, %true, zt2
                cr.cpmax = cr.cpmin + len(@zt2)
                control send hwnd, id, %em_exsetsel,0,varptr(cr)
                gosub search
                if isfalse match then msgbox "no further match found",%mb_iconinformation, "find"
            else
                msgbox "no match found",%mb_iconinformation, "find"
            end if
        elseif (@lppfr.flags and %fr_replaceall) then ' replace all
            gosub search
            if istrue match then
                do
                    control send hwnd, id, %em_replacesel, %true, zt2
                    cr.cpmax = cr.cpmin + len(@zt2)
                    control send hwnd, id, %em_exsetsel,0,varptr(cr)
                    gosub search
                loop until isfalse match    ' loop until no more matches
            else
                msgbox "no match found",%mb_iconinformation, "find"
            end if
        end if
        function = 1 : exit function
        '
        positioncheck:
            ' get selected text for checking purposes
            tf.chrg.cpmin = cr.cpmin
            tf.chrg.cpmax = cr.cpmax
            buf = space$(cr.cpmax - cr.cpmin + 1)
            tf.lpstrtext = strptr(buf)
            control send hwnd, id, %em_gettextrange, 0, varptr(tf)
            '
            ' adjust start position of search if necessary - to avoid being stuck in the same place.
            if (left$(ucase$(buf),len(buf)-1) = przt) and (cr.cpmin < cr.cpmax) then incr cr.cpmin
        return
        '
        search:
            ' get upper limit of searching range
            control send hwnd, id, %em_getlimittext,0,0 to textmax&
            tf.chrg.cpmin = cr.cpmin
            tf.chrg.cpmax = textmax&
            tf.lpstrtext  = zt
            '
            ' do specified search for specified text
            control send hwnd, id, %em_findtext, searchflag&, varptr(tf) to ipos
            if ipos <> -1 then ' search is successful
                cr.cpmin = ipos
                cr.cpmax = cr.cpmin + len(@zt)
                '
                ' select found text
                control send hwnd, id, %em_exsetsel, 0, varptr(cr)
                ' save search string for checking purposes.
                przt = ucase$(trim$(@zt))
                ' match found
                match = %true
            else
                match = %false
            end if
        return
        '
    end function
    '
    '
    callback function form1_dlgproc
        static flgs as long ' saving find or replace flags between calls.
        '
        select case cbmsg
            case msgfindreplace ' this is the message registered
                ' do actions in response to your input in the dialog box
                function = dofindreplaceaction(cblparam, cbhndl, %textbox1, flgs)
                '
            case %wm_destroy
                postquitmessage 0
                '
            case %wm_command
                select case cbctlmsg
                    case %bn_clicked, 1 ' accelerator notification codes have cbctlmsg set to 1.
                        select case cbctl
                            case %buttonfind
                                hdlgmodeless = openfindorreplacetextdialog(cbhndl, 1, flgs)
                                function = 1
                            case %buttonreplace
                                hdlgmodeless = openfindorreplacetextdialog(cbhndl, 2, flgs)
                                function = 1
                            case %buttonexit
                                dialog end cbhndl, 0
                                function = 1
                            case else
                        end select
                    case else
                end select
            case else
        end select
    end function
    '
    '
    ' this wonderful function has been provided by martin francom. thanks a lot!
    '
    '*** this routine will allow you to 'programmatically' create
    '*** rtf files that can be displayed/printed by wordpad or rtfprint.exe
    '*** you could expand this function by adding code for 'tables' and 'graphics'
    '*** if you make improvements, please post them to this forum so
    '*** all pb'ers may benifit.
    '*** this routine is released to public domain by martin framcom
    '
    function rtf (st$) as string
      local fontsize&
      if instr(ucase$(st$),"font") then    ' ie "fontc24"
        fontsize&= val(mid$(st$,6)): st$= mid$(st$,5,1)
      end if
      select case ucase$(st$)
        case "start"
          st$ = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033\deflangfe1033"+ $crlf
          st$ = st$ + "{\fonttbl{\f0\fmodern\fprq1\fcharset0 courier new;}"+ $crlf
          st$ = st$ + "{\f1\fnil\fcharset0 times new roman;}"+ $crlf
          st$ = st$ + "{\f2\fmodern\fprq1\fcharset0 andale mono;}"+ $crlf
          st$ = st$ + "{\f3\fmodern\fprq1\fcharset0 lucida console;}"+ $crlf
          st$ = st$ + "{\f4\froman\fprq2\fcharset0 georgia;}}" + $crlf
          st$ = st$ + "{\colortbl "+ $crlf
          st$ = st$ + ";\red128\green0\blue0"+ $crlf
          st$ = st$ + ";\red0\green128\blue0"+ $crlf
          st$ = st$ + ";\red128\green128\blue0"+ $crlf
          st$ = st$ + ";\red0\green0\blue128"+ $crlf
          st$ = st$ + ";\red128\green0\blue128"+ $crlf
          st$ = st$ + ";\red0\green128\blue128"+ $crlf
          st$ = st$ + ";\red128\green128\blue128"+ $crlf
          st$ = st$ + ";\red192\green192\blue192"+ $crlf
          st$ = st$ + ";\red255\green0\blue0"+ $crlf
          st$ = st$ + ";\red0\green255\blue0"+ $crlf
          st$ = st$ + ";\red255\green255\blue0"+ $crlf
          st$ = st$ + ";\red0\green0\blue255"+ $crlf
          st$ = st$ + ";\red255\green0\blue255"+ $crlf
          st$ = st$ + ";\red0\green255\blue255"+ $crlf
          st$ = st$ + ";\red255\green255\blue255;}"+ $crlf
          st$ = st$ + "\cf1\f0\fs11 " + $crlf
        case "c"    'courier new fixed size
           if fontsize& > 10 and fontsize& < 72 then st$ = "\f0" else st$="
        case "t"    'times new roman variable size
           if fontsize& > 10 and fontsize& < 72 then st$ = "\f1" else st$="
        case "a"    'andale mono fixed size
           if fontsize& > 10 and fontsize& < 72 then st$ = "\f2" else st$="
        case "l"    'lucidia console fixed size
           if fontsize& > 10 and fontsize& < 72 then st$ = "\f3" else st$="
        case "g"    'lucidia console fixed size
           if fontsize& > 10 and fontsize& < 72 then st$ = "\f4" else st$="
        case "end"    'end of rtf file
          st$ = "} "
        case "eol"    'end of line
          st$ = "\line "
        case "eop"    'end of paragraph
          st$ = "\par "
        case "newpage" 'end of page
          st$ = "\page "
        case "bold"
          st$ = "\b "
        case "unbold"
          st$ = "\b0 "
        case "italic"
          st$ = "\i "
        case "unitalic"
          st$ = "\i0 "
        case "underline"
          st$ = "\ul "
        case "ununderline"
          st$ = "\ul0 "
        case "center"
          st$ = "\pard\qc "
        case "right"
          st$ = "\pard\qr "
        case "left"
          st$ = "\pard "
        case "black"   'foreground color
           st$ = "\cf0 "
        case "maroon"   'foreground color
           st$ = "\cf1 "
        case "green"   'foreground color
           st$ = "\cf2 "
        case "olive"   'foreground color
           st$ = "\cf3 "
        case "navy"   'foreground color
           st$ = "\cf4 "
        case "purple"   'foreground color
           st$ = "\cf5 "
        case "teal"   'foreground color
           st$ = "\cf6 "
        case "grey"   'foreground color
           st$ = "\cf7 "
        case "silver"   'foreground color
           st$ = "\cf8 "
        case "red"   'foreground color
           st$ = "\cf9 "
        case "lime"   'foreground color
           st$ = "\cf10 "
        case "yellow"   'foreground color
           st$ = "\cf11 "
        case "blue"   'foreground color
           st$ = "\cf12 "
        case "fuchsia"   'foreground color
           st$ = "\cf13 "
        case "auqua"   'foreground color
           st$ = "\cf14 "
        case "white"   'foreground color
           st$ = "\cf15 "
        case else
           st$="
      end select
      select case fontsize&
        case 5
           st$ = st$ + "\fs11 "
        case 6
           st$ = st$ + "\fs12 "
        case 7
           st$ = st$ + "\fs14 "
        case 8
           st$ = st$ + "\fs16 "
        case 9
           st$ = st$ + "\fs18 "
        case 10
           st$ = st$ + "\fs20 "
        case 11
           st$ = st$ + "\fs22 "
        case 12
           st$ = st$ + "\fs24 "
        case 14
           st$ = st$ + "\fs28 "
        case 16
           st$ = st$ + "\fs32 "
        case 18
           st$ = st$ + "\fs36 "
        case 20
           st$ = st$ + "\fs40 "
        case 22
           st$ = st$ + "\fs44 "
        case 24
           st$ = st$ + "\fs48 "
        case 26
           st$ = st$ + "\fs52 "
        case 28
           st$ = st$ + "\fs56 "
        case 36
           st$ = st$ + "\fs72 "
        case 48
           st$ = st$ + "\fs96 "
        case 72
           st$ = st$ + "\fs144 "
      end select
      rtf=st$
    end function
    '
    ' this fine function has been provided by borje hagsten. many thanks.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' rich edit stream in callback - for streaming in string contents
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    function richeditstreaminstring (byval dwcookie as dword, byval pbbuff as byte ptr, _
                                     byval cb as long, pcb as long) as dword
    
      pcb = cb               'number of bytes to copy
      if pcb > 0 then        'copy block from global string directly into richedit's buffer.
         copymemory pbbuff, (gptr + gpos - 1), pcb  'could use poke$ too, but this is a bit faster
         gpos = gpos + pcb   'incr pos for next callback position.
      end if
    
    end function
    '
    '
    function pbmain
        local msg as tagmsg
        local haccel as long
        local rtfst$
        local hlib as long
        local ff as long, t as single, estream as editstream
        dim ac(0 to 2) as accelapi
        ' register a message for the find or replace dialog.
        msgfindreplace = registerwindowmessage ("commdlg_findreplace")
        dialog new 0, "find and replace common dialogs in rich edit control", 0, 0,  357,  246, _
            %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center, 0 to hform1&
        control add button, hform1&,  %buttonfind,  "find  -  ctrl+f", 32, 219, 80, 15, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1&,  %buttonreplace,  "replace  -  ctrl+r", 139, 219, 80, 15, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1&,  %buttonexit,  "exit  -  alt+x", 245, 219, 80, 15, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        '
        ' rtf text originally provided by marty francom. many thanks.
        rtfst$= rtf("start")+ rtf("fontc72")+ rtf("center")+rtf("maroon")+"sample file"+rtf("eop")
        rtfst$=rtfst$ + rtf("left")+rtf("black")+ rtf("fonta12")
        rtfst$=rtfst$ + "this routine built by marty francom, use it, modify it, share it with"+rtf("eol")
        rtfst$=rtfst$ + "others as you see fit. if you make improvements or add features, please"+rtf("eol")
        rtfst$=rtfst$ + "share them with the powerbasic forum." +rtf("eol")+rtf("eop")
        rtfst$=rtfst$ + rtf("fontg14")+ rtf("green")
        rtfst$=rtfst$ + "when building an rtf file with this routine always start"+rtf("eol")
        rtfst$=rtfst$ + "the file with rtf('start') and end building the file"+rtf("eol")
        rtfst$=rtfst$ + "with rtf('end')" + rtf("bold")+ rtf("fuchsia") +"    everything else is optional."+ rtf("unbold")+rtf("eop")
        rtfst$=rtfst$ + rtf("eol")   'rtf("newpage")
        rtfst$=rtfst$ + rtf("left")+rtf("red")+ rtf("fontl16")+rtf("unbold") + rtf("italic")
        rtfst$=rtfst$ + "some italic text in newtimesroman font 16 point in red." +rtf("eol")+rtf("eop")
        rtfst$=rtfst$ + rtf("right")+rtf("red")+ rtf("fontc12")+rtf("unitalic") + rtf("bold")
        rtfst$=rtfst$ + "some bold text in courier font 12 point in blue. right justified." + rtf("eol")+rtf("eol")
        rtfst$=rtfst$ + rtf("left")+rtf("green")+ rtf("unbold")
        rtfst$=rtfst$ + rtf("fontt10")+"some text"+ rtf("blue")+rtf("fontl22")+" in different" + rtf("fonta16")+ rtf("maroon")+" font sizes "+ rtf("fontn8")+ rtf("black")+rtf("bold")+ "and colors." +rtf("eol")+rtf("eop")
        rtfst$=rtfst$ + rtf("fontt16")+ "the command line syntax is  rtfprint filename.rtf action& numcopy&"+rtf("eol")
        rtfst$=rtfst$ + rtf("center")+ rtf("fontt20")+ rtf("fuchsia") +"ie:  rtfprint sample.rtf 0 2" + rtf("eol")
        rtfst$=rtfst$ + rtf("end")
        '
        hlib = loadlibrary("riched32.dll")
        if hlib = 0 then exit function
        control add "richedit", hform1&,  %textbox1, ", 32, 27, 293, 180, _
            %ws_child or %ws_visible or %es_multiline or %es_nohidesel or %es_wantreturn or %es_left or %es_autovscroll or %ws_vscroll or %ws_tabstop, _
            %ws_ex_clientedge
        '
        gtxt = rtfst$
        '   this code was provided by borje hagsten. thanks.
        gpos                = 1             'position in text to start from
        gptr                = strptr(gtxt)  'pointer to global text buffer
        estream.pfncallback = codeptr(richeditstreaminstring) 'pointer to richedit callback procedure
        control send hform1&,  %textbox1, %em_streamin, %sf_rtf, varptr(estream) 'stream in text
        '
        ' attach keyboard accelerators.
        ac(0).fvirt = %fcontrol or %fvirtkey
        ac(0).key = asc("f")
        ac(0).cmd = %buttonfind
        ac(1).fvirt = %fcontrol or %fvirtkey
        ac(1).key = asc("r")
        ac(1).cmd = %buttonreplace
        ac(2).fvirt = %falt or %fvirtkey
        ac(2).key = asc("x")
        ac(2).cmd = %buttonexit
        accel attach hform1&, ac() to haccel
        '
        dialog show modeless hform1& , call form1_dlgproc
        '
        ' expanded sdk-style main message loop
        ' acquire and dispatch messages until a wm_quit message is received.
        '
        ' this particular version was originally proposed by dominic mitchell - thanks!
        while istrue getmessage(msg, byval %null, 0, 0)
           ' if isfalse translatemdisysaccel(ghwndclient, msg) then
                if isfalse translateaccelerator(hform1, haccel, msg) then
                    if isfalse isdialogmessage(hdlgmodeless, msg) then
                        translatemessage msg
                        dispatchmessage msg
                    end if
                end if
           ' end if
        wend
    end function


    [this message has been edited by erik christensen (edited august 29, 2005).]
Working...
X