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

Function list utility - F2 plus? exploration

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

  • PBWin Function list utility - F2 plus? exploration

    There was a discussion here : http://www.powerbasic.com/support/pb...913#post322913 and another here: http://www.powerbasic.com/support/pb...ad.php?t=41453
    Code:
    '
    ' Experimenting with a function/sub list for a code module
    ' starting off with a basic function list like the F2 list in the PB compilers
    ' Each function or sub can be viewed in a seperate window
    ' Synchronises with the last saved version of the subject file
    '
    ' Chris Holbrook 12-Sep-2009
    '
    #compile exe
    #debug display
    #dim all
    
    #if not %def(%WINAPI)
        #include "WIN32API.INC"
    #endif
    #if not %def(%COMMCTRL_INC)
        #include "COMMCTRL.INC"
    #endif
    
    %IDD_DIALOG1         =  101
    %IDC_LV = 1001
    %IDD_DIALOG2         =  102
    %IDC_TEXTBOX1        = 1003
    
    type tfindex
        sfname as asciz * 256
        start as long
        finish as long
        hwnd as dword
    end type
    global findex() as tfindex      ' global table of functions and subs
    global sourcecode() as string   ' global table of source code
    '---------------------------------------------------------------------------
    function build ( hD as dword, LVid as long, sfile as string) as long
        local i, n, hfile, nrow, linenum as long
        local s, sline, s1, s2, s3, slist, swork as string
    '
        dialog set text hd, "F2plus " + sfile + time$
        hfile = freefile
        try
            open sfile for input as hfile
            linenum = 1
            nrow = 1
            while isfalse eof(hfile)
                line input #hfile, sline
                SWORK = SLINE + " @@@@@@@@"
                s1 = ucase$(parse$(ltrim$(swork), " ", 1))
                s2 = ucase$(parse$(ltrim$(swork), any " (", 2))
                s3 = ucase$(parse$(ltrim$(swork), any " (", 3))
                select case s1
                    case "SUB"
                        gosub addtolist
                    case "FUNCTION"
                        if left$(s2,1) <> "=" then gosub addtolist
                    case "CALLBACK"
                        gosub addtolist
                    case "END"
                        if left$(s2,8) = "FUNCTION" then
                            gosub nudgelist
                            exit select
                        end if
                        if left$(s2,3) = "SUB" then
                            gosub nudgelist
                        end if
                end select
                n = ubound(sourcecode()) + 1
                redim preserve sourcecode(0 to n)
                sourcecode(n) = sline
                incr linenum
            wend
            close hfile
        catch
            dialog set text hd, "FILE ERROR": beep: sleep 2000
            exit function
        end try
        exit function
    '''''''''''''''
    addtolist:
        slist = slist + $crlf + sline
        if s1 = "CALLBACK" then
            s = s3
        else
            s = s2
        end if
        listview insert item hD, %IDC_LV, nrow, 0, s
        redim preserve findex(1 to nrow)
        findex(nrow).start = linenum
        findex(nrow).sfname = s
        if nrow > 1 then
            if findex(nrow -1).finish = 0 then
                findex(nrow-1).finish = linenum -1
            end if
        end if
        listview set text hD, %IDC_LV, nrow, 1, s
        listview set text hD, %IDC_LV, nrow, 2, sline
    return
    '''''''''''''''
    nudgelist:
        slist = slist + $crlf + "############ NUDGE ###############" + s1 + "@" + s2 + "@" + sline
        findex(nrow).finish = linenum -1
        incr nrow
    return
    end function
    '----------------------------------------------------------
    callback function CodeDlgProc()
        local x, y as long
    
        select case as long cbmsg
            case %wm_initdialog
            '
            case %wm_move, %wm_size
                dialog get client cb.hndl to x, y
                control set size cb.hndl, %IDC_TEXTBOX1, x, y
            '
            case %wm_ncactivate
                static hWndSaveFocus as dword
                if isfalse cbwparam then
                    hWndSaveFocus = GetFocus()
                elseif hWndSaveFocus then
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                end if
            '
            case %wm_destroy ' let the parent dialog know that we have finished
                dialog post getparent(cb.hndl), %wm_user + 501, cb.hndl, 0
            '
            case %wm_command
                select case as long cbctl
                    case %IDC_TEXTBOX1
    
                end select
        end select
    end function
    '--------------------------------------------------
    function CodeDlg(byval hParent as dword, fx as long) as long
        static xoffset, yoffset as long
    
        local lRslt as long
        local hDlg  as dword
        local i, nfrom, nto as long
        local s as string
    
        nfrom = findex(fx).start
        nto   = findex(fx).finish
        '? str$(nfrom) + str$(nto)
        xoffset += 5: yoffset += 5
        dialog new hParent, "F2+ code viewer", xoffset, yoffset, 201, 121, _
        %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or _
            %ws_minimizebox or %ws_clipsiblings or %ws_visible or _
            %ds_modalframe or %ds_3dlook or %ds_nofailcreate or _
            %ds_setfont or %ws_thickframe, _
            %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, to hDlg
        findex(fx).hWnd = hDlg
        control add textbox, hDlg, %IDC_TEXTBOX1, "", 0, 0, 192, 110, _
            %ws_child or %ws_visible or %ws_tabstop or %ws_hscroll _
            or %ws_vscroll or %es_left or %es_multiline or %es_autohscroll or %es_autovscroll or %es_readonly, %ws_ex_clientedge or _
            %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar
    
        control set color hDlg, %IDC_textbox1, -1, %white
        ' build the source code table
        s = ""
        for i = nfrom - 1 to nto
            s = s + $crlf + sourcecode(i)
        next
        s = mid$(s,2)
        control set text hDlg, %IDC_TEXTBOX1, s
        dialog get text hParent to s
        dialog set text hDlg, findex(fx).sfname + " in " + parse$(s," ", 2)
        dialog set user hDlg, 1, fx
        dialog show modeless hDlg, call CodeDlgProc to lRslt
    
        function = lRslt
    end function
    
    '--------------------------------------------------------
    callback function MainDlgProc()
        local i, j, l, n, nfrom, nto, nsel, x, y as long
        local s, soldcode as string
        local prevfindex() as tfindex
    
        static htimer as dword
        static sourcecodefile as string
        static dird, dird1 as dirdata
        '
        select case as long cbmsg
            case %wm_initdialog
                listview set stylexx cb.hndl, %IDC_LV, _
                    %LVS_ex_infotip or %LVS_EX_FULLROWSELECT or  %LVS_EX_ONECLICKACTIVATE or %LVS_EX_GRIDLINES
                listview reset cb.hndl, %IDC_LV
                listview  insert column cb.hndl, %IDC_LV, 1, "Name", 100, 0
                listview  insert column cb.hndl, %IDC_LV, 2, "header", 500, 0
                sourcecodefile = inputbox$("enter the source code module name")
                if trim$(sourcecodefile) = "" then
                    dialog end cb.hndl, 0
                end if
                if isfile(sourcecodefile) = 0 then
                    ? "file " + sourcecodefile + " not found!"
                    dialog end cb.hndl, 0
                end if
                s = dir$ (sourcecodefile to dird)
                build(cb.hndl, %IDC_LV, sourcecodefile)
                htimer = settimer ( cb.hndl,%null, 2000, %null)
            '
            case %wm_timer
                s = dir$ (sourcecodefile to dird1)
                if dird1.LastWriteTime <> dird.lastwritetime then
                    erase sourcecode() ' get rid of the previous sourcecode array
                    dird = dird1
                    listview reset cb.hndl, %IDC_LV
                    l = lbound(findex())
                    dim prevfindex(l to ubound(findex()))
                    poke$ varptr(prevfindex(l)), peek$(varptr(findex(l)),sizeof(findex(l)) * arrayattr(findex(),4))
                    erase findex()
                    build(cb.hndl, %IDC_LV, sourcecodefile)
                    for i = lbound(findex()) to ubound(findex())
                         if prevfindex(i).hWnd then
                             ' get the text in the "new" file for the named Function
                             s = trim$(prevfindex(i).sfname)
                             listview find exact cb.hndl, %IDC_LV, 1, s to n
                             ' if the function no longer exists, kill the viewer window and exit
                             if n = 0 then
                                 dialog end prevfindex(i).hWnd, 0
                                 exit select
                             end if
                             ' fn is present, get its text
                             s = ""
                             for j = findex(n).start - 1 to findex(n).finish
                                 s = s + $crlf + sourcecode(j)
                             next
                             s = mid$(s,2)
                             control get text prevfindex(i).hWnd, %IDC_TEXTBOX1 to soldcode
                             ' compare it with the version in the viewer window
                             ' if different, kill the viewer window and create a new one
                             ' if the same, update the entry in the current findex table for
                             ' the existing code window
                             if s <> soldcode then
                                 dialog end prevfindex(i).hWnd, 0
                                 codedlg ( cb.hndl, n )
                             else
                                 findex(i).hWnd = prevfindex(i).hWnd
                             end if
                         end if
                    next
                end if
            '
            case %wm_destroy
                killtimer cb.hndl, htimer
            '
            case %wm_user + 501 ' child dialog has ended - clear hWnd in findex table
                for i = lbound(findex()) to ubound(findex())
                    if findex(i).hWnd = cb.wparam then
                        findex(i).hWnd = 0
                        exit for
                    end if
                next
                '
            case %wm_move, %wm_size
                dialog get client cb.hndl to x, y
                control set size cb.hndl, %IDC_LV, x, y
            '
            case %wm_notify
                select case cb.ctl
                    case %IDC_LV
                        select case cb.nmcode
                            case %nm_click
                                listview get select cb.hndl, %IDC_LV to nsel
                                'listview get user cb.hndl, %IDC_LV, nsel to n
                                nfrom = findex(nsel).start
                                nto   = findex(nsel).finish
                                CodeDlg(cb.hndl, nsel)
                        end select
                end select
            '
            case %wm_ncactivate
                static hWndSaveFocus as dword
                if isfalse cbwparam then
                    hWndSaveFocus = GetFocus()
                elseif hWndSaveFocus then
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                end if
        end select
    end function
    '------------------------------------------------------------------------
    function MainDlg(byval hParent as dword) as long
        local lRslt as long
        local hDlg  as dword
    
        dialog new hParent, "F2+", 193, 143, 201, 121, _
            %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or %ws_minimizebox or _
            %ws_clipsiblings or %ws_visible or %ds_modalframe or %ds_3dlook or _
            %ds_nofailcreate or %ds_setfont or %ws_thickframe, _
            %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _
            to hDlg
        control add "SysListView32", hDlg, %IDC_LV, "SysListView32_1", 0, 0, 192, 100, _
            %ws_child or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways, _
            %ws_ex_left or %ws_ex_clientedge or %ws_ex_rightscrollbar
        dialog show modal hDlg, call MainDlgProc to lRslt
    
        function = lRslt
    end function
    '---------------------------------------------------------------------
    function pbmain()
        initcommoncontrols
        MainDlg %hwnd_desktop
    end function
    Last edited by Chris Holbrook; 12 Sep 2009, 10:29 AM.

  • #2
    added keyword colors etc

    This code works on XP professional SP3.
    Discussion http://www.powerbasic.com/support/pb...379#post323379

    Code:
    '
    ' Experimenting with a function/sub list for a code module
    ' starting off with a basic function list like the F2 list in the PB compilers
    ' Each function or sub can be viewed in a seperate window
    ' Synchronises with the last saved version of the subject file by checking the directory entry
    ' of the target file and reloading the function index and any changed windows
    '
    ' Chris Holbrook 12-Sep-2009
    '
    ' Changes
    ' 13-SEP-2009 includes comments preceding sub/function header in the function viewer windows
    ' 13-SEP-2009 uses keyword, comment and literal coloring
    '
    ' Issues
    ' 13-SEP-2009 PB keyword list is for PBWin V7 only
    ' 14-SEP-2009 refreshes all viewer windows when any change occurs, not just the changed ones.
    '
    #compile exe
    #debug display
    #dim all
    
    #if not %def(%WINAPI)
        #include "WIN32API.INC"
    #endif
    #if not %def(%COMMCTRL_INC)
        #include "COMMCTRL.INC"
    #endif
    #if not %def(%COMDLG32_INC)
        #include "COMDLG32.INC"
    #endif
    #include "richedit.inc"
    #include "CCE_BASRO.INC"   
    $version = "0.1.2"
    %IDD_DIALOG1         =  101
    %IDC_LV = 1001
    %IDD_DIALOG2         =  102
    %IDC_TEXTBOX1        = 1003
    %IDC_SOUFILE_BN      = 1004
    
    type tfindex
        sfname as asciz * 256
        start as long
        finish as long
        hwnd as dword
    end type
    global findex() as tfindex      ' global table of functions and subs
    global sourcecode() as string   ' global table of source code
    global ghfont as dword          ' font
    '---------------------------------------------------------------------------
    function build ( hD as dword, LVid as long, sfile as string) as long
        local i, j, n, hfile, nrow, linenum as long
        local s, sline, s1, s2, s3, slist, swork as string
    '
        hfile = freefile
        try
            open sfile for input as hfile
            linenum = 1
            while isfalse eof(hfile)
                line input #hfile, sline
                n = ubound(sourcecode()) + 1
                redim preserve sourcecode(0 to n)
                sourcecode(n) = sline
                incr linenum
            wend
            close hfile
        catch
            dialog set text hd, "FILE ERROR": beep: sleep 2000
            exit function
        end try
        ' pick out functions & subs from the array
        for i = lbound(sourcecode()) to ubound(sourcecode())
            SWORK = Sourcecode(i) + " @@@@@@@@"
            s1 = ucase$(parse$(ltrim$(swork), " ", 1))
            s2 = parse$(ltrim$(swork), any " (", 2)
            s3 = parse$(ltrim$(swork), any " (", 3)
            select case s1
                case "SUB"
                    gosub addtolist
                case "FUNCTION"
                    if left$(s2,1) <> "=" then gosub addtolist
                case "CALLBACK"
                    gosub addtolist
                case "END"
                    if ucase$(left$(s2,8)) = "FUNCTION" then
                        gosub nudgelist
                        exit select
                    end if
                    if ucase$(left$(s2,3)) = "SUB" then
                        gosub nudgelist
                    end if
            end select
        next
    
        s = ""
        for i = 50 to ubound(findex())
            s = s + str$(i) + str$(findex(i).start) + str$(findex(i).finish) + " " + findex(i).sfname + $crlf
        next
    
        exit function
    '''''''''''''''
    addtolist:
        incr nrow
        j = 1
        do while (i-j) > 0
            s = ltrim$(sourcecode(i - j))
            if left$(ltrim$(s),1) = $sq then
                incr j
            else
                exit loop
            end if
        loop
        if s1 = "CALLBACK" then
            s = s3
        else
            s = s2
        end if
        listview insert item hD, %IDC_LV, nrow, 0, s
        redim preserve findex(1 to nrow)
        findex(nrow).start = i - j + 1
        findex(nrow).sfname = s'sourcecode(i)
        if nrow > 1 then
            if findex(nrow -1).finish = 0 then
                findex(nrow-1).finish = i -1
            end if
        end if
        listview set text hD, %IDC_LV, nrow, 2, sourcecode(i)
    return
    '''''''''''''''
    nudgelist:
        findex(nrow).finish = i
    return
    end function
    '--------------------------------------------------------
    callback function MainDlgProc()
        local i, j, l, n, nfrom, nto, nsel, x, y as long
        local s, soldcode, spath as string
        ' temporary array into which the old findex array is copied
        ' when a dirent change is detected
        local prevfindex() as tfindex
        ' rect used to define CCE window
        local r as rect
    
        ' used in checking the dirent for updates
        static htimer as dword
        ' filename and dialog title
        static sourcecodefile, stitle as string
        ' used in checking the dirent for updates
        static dird, dird1 as dirdata
        ' index in the Findex array of the subject of a call to CCE_BASRO
        ' used by the wm_user + 500 handler - message passed back from BBE_BASRO
        ' to identify the CCE dialog and control
        static editx as long
        ' Control id of the Edit control passed back in wm_user + 500 msg
        static lEditCtlId as long
        '
        select case as long cbmsg
            case %wm_initdialog
    '            dialog set text cb.hndl, "wm_init"
                listview set stylexx cb.hndl, %IDC_LV, _
                    %LVS_ex_infotip or %LVS_EX_FULLROWSELECT or  %LVS_EX_ONECLICKACTIVATE or %LVS_EX_GRIDLINES
                listview reset cb.hndl, %IDC_LV
                listview  insert column cb.hndl, %IDC_LV, 1, "Name", 100, 0
                listview  insert column cb.hndl, %IDC_LV, 2, "header", 500, 0
                stitle = "F2+ Source Code File Selection"
                gosub setsourcecodefile
                if trim$(sourcecodefile) = "" then
                    dialog end cb.hndl, 0
                end if
                if isfile(sourcecodefile) = 0 then
                    ? "file " + sourcecodefile + " not found!"
                    dialog end cb.hndl, 0
                end if
                s = dir$ (sourcecodefile to dird)
                build(cb.hndl, %IDC_LV, sourcecodefile)
                htimer = settimer ( cb.hndl,%null, 2000, %null)
            '
            case %wm_destroy
                killtimer cb.hndl, htimer
                if ubound(findex()) < 0 then exit select
                for i = lbound(findex()) to ubound(findex())
                    if findex(i).hWnd <> 0 then
                        dialog end findex(i).hWnd, 0
                    end if
                next
            '
            case %wm_timer
                'dialog set text cb.hndl, "wm_timer"
                s = dir$ (sourcecodefile to dird1)
                if dird1.LastWriteTime <> dird.lastwritetime then
                    erase sourcecode() ' get rid of the previous sourcecode array
                    dird = dird1
                    listview reset cb.hndl, %IDC_LV
                    l = lbound(findex())
                    dim prevfindex(l to ubound(findex()))
                    poke$ varptr(prevfindex(l)), peek$(varptr(findex(l)),sizeof(findex(l)) * arrayattr(findex(),4))
                    erase findex()
                    build(cb.hndl, %IDC_LV, sourcecodefile)
                    for i = lbound(findex()) to ubound(findex())
                         if prevfindex(i).hWnd then
                             ' get the text in the "new" file for the named Function
                             ' kill off viewer window
                             dialog end prevfindex(i).hWnd, 0
                             s = trim$(prevfindex(i).sfname)
                             listview find exact cb.hndl, %IDC_LV, 1, s to n
                             ' if the function no longer exists, no further action required
                             if n = 0 then exit select
                             ' fn is present, create a new window
                             s = ""
                             for j = findex(i).start to findex(i).finish
                                 s = s + $crlf + sourcecode(j)
                             next
                             s = mid$(s, 3) ' lose leading $crlf
                             stitle = findex(i).sfname + " in " + sourcecodefile + " " + time$
                             setrect r, 0, 0, 400, 300
                             editx = i
                             CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                         end if
                    next
                end if
            '
            case %wm_user + 500 ' CCE_BASRO is passing hWnds
                findex(editx).hWnd = cb.wparam ' store the CCE dialog hWnd
                lEditCtlId = cb.lparam
            '
            case %wm_user + 501 ' child dialog has ended - clear hWnd in findex table
                for i = lbound(findex()) to ubound(findex())
                    if findex(i).hWnd = cb.wparam then
                        findex(i).hWnd = 0
                        exit for
                    end if
                next
            '
            case %wm_move, %wm_size
                local xx, yy as long
                if cb.wparam = %SIZE_MINIMIZED then
                    for i = lbound(findex()) to ubound(findex())
                        if findex(i).hWnd <> 0 then
                            dialog send findex(i).hWnd, %wm_syscommand, %sc_minimize, 0
                        end if
                    next
                end if
                dialog get client cb.hndl to x, y
                control set size cb.hndl, %IDC_LV, x, y
                control get size cb.hndl, %IDC_SOUFILE_BN to xx, yy
                control set size cb.hndl, %IDC_SOUFILE_BN, x, yy
            '
            case %wm_notify
                select case cb.ctl
                    case %IDC_LV
                        select case cb.nmcode
                            case %nm_click
                                listview get select cb.hndl, %IDC_LV to nsel
                                'l = ubound(findex)
                                nfrom = findex(nsel).start
                                nto   = findex(nsel).finish
                                for i = findex(nsel).start to findex(nsel).finish
                                    s = s + $crlf + sourcecode(i)
                                next
                                s = mid$(s,3)
                                stitle = findex(nsel).sfname + " in " + sourcecodefile + " " + time$
                                setrect r, 0, 0, 400, 300
                                editx = nsel
                                CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                        end select
                end select
            '
            case %wm_command
                select case cb.ctl
                    case %IDC_SOUFILE_BN
                        gosub setsourcecodefile
                end select
            '
            case %wm_ncrbuttondown
                for i = lbound(findex()) to ubound(findex())
                     s = s + str$(findex(i).start) + str$(findex(i).finish) + " " + findex(i).sfname + $crlf
                next
                ?s
            '
            case %wm_ncactivate
                static hWndSaveFocus as dword
                if isfalse cbwparam then
                    hWndSaveFocus = GetFocus()
                elseif hWndSaveFocus then
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                end if
        end select
        exit function
    ''''''''''''''''''''''
    setsourcecodefile:
        spath = curdir$
        OpenFileDialog(cb.hndl, stitle, sourcecodefile, sPATH, _
            "Basic Source Code Files|*.bas|Include Files|*.inc|All Files|*.*", "txt", 0)
        control set text cb.hndl, %IDC_SOUFILE_BN, sourcecodefile
    return
    end function
    '------------------------------------------------------------------------
    function MainDlg(byval hParent as dword) as long
        local lRslt, w, h as long
        local hDlg  as dword
    
        dialog font default "Courier New", 10, 0, 0
        dialog new hParent, "F2+", 0, 0, 201, 121, _
            %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or %ws_minimizebox or _
            %ws_clipsiblings or %ws_visible or %ds_modalframe or %ds_3dlook or _
            %ds_nofailcreate or %ds_setfont or %ds_center or %ws_thickframe, _
            %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _
            to hDlg
        dialog get client hDlg to w, h
        control add button, hDlg, %IDC_SOUFILE_BN, "source code file", 0, 0, w, 14
        control add "SysListView32", hDlg, %IDC_LV, "SysListView32_1", 0, 15, 192, 100, _
            %ws_child or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways, _
            %ws_ex_left or %ws_ex_clientedge or %ws_ex_rightscrollbar
        dialog show modal hDlg, call MainDlgProc to lRslt
        function = lRslt
    end function
    '---------------------------------------------------------------------
    function pbmain()
        initcommoncontrols
        MainDlg %hwnd_desktop
    end function
    this is the CCE_BASRO.INC file:
    Code:
    '------------------------------------------------------------------------------------------------------
    ' COMPACT CODE EDITOR CCE.INC
    ' Chris Holbrook July 2008
    ' including some code by Charles Dietz, Eric Christensen and Borje Hagsten
    ' modified to use with F2plus application
    '
    
    ' CHANGES
    ' 13-SEP-2009 subset for RO PB Code viewing
    '============================================
    
    
    %CCE_MAXTEXTSIZE = 32768
    global gKeywords as string
    global ghlib as dword
    '--------------------------------------------------------------------------------------
    'PBWin 7.0 syntax color data - think at least most of it..  :-)
    '----------------------------------------------------------------------------
    '
    sub CreatePBKeyWordString
        local hfile as long
        local s as string
        static slangwords, skeywords as string
    
        sLangWords = " ,=-+*/\(;" + $crlf + _
                     "'"         + $crlf + _
                     $dq          + $crlf
        sKeyWords = _
    "#BLOAT,#COMPILE,#DEBUG,#DIM,#ELSE,#ELSEIF,#ENDIF,#IF,#INCLUDE,#OPTION,#REGISTER,#RESOURCE," + _
    "#SEGMENT,#STACK,#TOOLS,$BEL,$BS,$COMPILE,$CR,$CRLF,$DEBUG,$DIM,$DQ,$ELSE,$ELSEIF,$ENDIF," + _
    "$EOF,$ESC,$FF,$IF,$INCLUDE,$LF,$NUL,$OPTION,$REGISTER,$RESOURCE,$SEGMENT,$SPC,$STACK," + _
    "$TAB,$VT,%DEF,%FALSE,%NULL,%PB_EXE,%TRUE," + _
    "ABS,ACCEL,ACCEPT,ACCESS,ACODE$,ADD,ADDR,ALIAS,ALL,AND,ANY,APPEND,ARRAY,ARRAYATTR," + _
    "AS,ASC,ASCEND,ASCIZ,ASCIIZ,AT,ATN,ATTACH,ATTRIB,BAR,BASE,BAUD,BDECL,BEEP," + _
    "BIN$,BINARY,BIT,BITS%,BITS&,BITS?,BITS??,BITS???,BREAK,BUTTON,BYCMD,BYCOPY,BYREF," + _
    "BYTE,BYVAL,CALC,CALL,CALLBACK,CALLSTK,CALLSTK$,CALLSTKCOUNT,CASE,CATCH,CBCTL,CBCTLMSG," + _
    "CBHNDL,CBLPARAM,CBMSG,CBWPARAM,CBYT,CCUR,CCUX,CD,CDBL,CDECL,CDWD,CEIL,CEXT,CHDIR," + _
    "CHDRIVE,CHECK,CHECK3STATE,CHECKBOX,CHOOSE,CHOOSE&,CHOOSE%,CHOOSE$,CHR$,CINT,CLIENT,CLNG," + _
    "CLOSE,CLS,CLSID$,CODEPTR,COLLATE,COLOR,COLUMN,COMBOBOX,COMM,COMMAND$,CON,CONNECT,CONST,CONTROL," + _
    "COS,CQUD,CREATE,CSET,CSET$,CSNG,CTSFLOW,CUR,CURDIR$,CURRENCY,CURRENCYX,CUX,CVBYT,CVCUR," + _
    "CVCUX,CVD,CVDWD,CVE,CVI,CVL,CVQ,CVS,CVWRD,CWRD,DATA,DATACOUNT,DATE$,DECLARE,DECR,DEFAULT," + _
    "DEFBYT,DEFCUR,DEFCUX,DEFDBL,DEFDWD,DEFEXT,DEFINT,DEFLNG,DEFQUD,DEFSNG,DEFSTR,DEFWRD,DELETE," + _
    "DESCEND,DIALOG,DIM,DIR$,DISABLE,DISKFREE,DISKSIZE,DISPATCH,DLL,DLLMAIN,DO,DOEVENTS,DOUBLE," + _
    "DOWN,DRAW,DSRFLOW,DSRSENS,DTRFLOW,DTRLINE,DWORD,ELSE,ELSEIF,EMPTY,ENABLE,END,ENVIRON$," + _
    "EOF,EQV,ERASE,ERR,ERRAPI,ERRCLEAR,ERROR,ERROR$,EXE,EXIT,EXP,EXP10,EXP2,EXPLICIT,EXPORT," + _
    "EXT,EXTENDED,EXTRACT$,FILEATTR,FILECOPY,FILENAME$,FILESCAN,FILL,FINALLY,FIX,FLOW,FLUSH,FOCUS," + _
    "FONT,FOR,FORMAT$,FORMFEED,FRAC,FRAME,FREEFILE,FROM,FUNCTION,FUNCNAME$,GET,GET#,GET$," + _
    "GETATTR,GLOBAL,GOSUB,GOTO,GUID$,GUIDTXT$,HANDLE,HEX$,HIBYT,HIINT,HIWRD,HOST,ICASE,ICON," + _
    "IDN,IF,IFACE,IIF,IIF&,IIF%,IIF$,IMAGE,IMAGEX,IMGBUTTON,IMGBUTTONX,IMP,IN,INCR,INP,INOUT," + _
    "INPUT,INPUT#,INPUTBOX$,INSERT,INSTR,INT,INTERFACE,INTEGER,INV,ISFALSE,ISNOTHING," + _
    "ISOBJECT,ISTRUE,ITERATE,JOIN$,KILL,LABEL,LBOUND,LCASE$,LEFT,LEFT$,LEN,LET,LIB,LIBMAIN," + _
    "LINE,LISTBOX,LISTVIEW,LOBYT,LOC,LOCAL,LOCK,LOF,LOG,LOG10,LOG2,LOINT,LONG,LOOP,LOWRD,LPRINT," + _
    "LSET,LSET$,LTRIM$,MACRO,MACROTEMP,MAIN,MAKDWD,MAKINT,MAKLNG,MAKPTR,MAKWRD,MAT,MAX,MAX$," + _
    "MAX%,MAX&,MCASE$,MEMBER,MENU,MID$,MIN,MIN$,MIN%,MIN&,MKBYT$,MKCUR$,MKCUX$,MKD$," + _
    "MKDIR,MKDWD$,MKE$,MKI$,MKL$,MKQ$,MKS$,MKWRD$,MOD,MODAL,MODELESS,MOUSEPTR,MSGBOX," + _
    "NAME,NEW,NEXT,NONE,NOT,NOTHING,NOTIFY,NULL,OBJACTIVE,OBJECT,OBJPTR,OBJRESULT,OCT$,OF," + _
    "OFF,ON,OPEN,OPT,OPTION,OPTIONAL,OR,OUT,OUTPUT,PAGE,PARITY,PARITYCHAR,PARITYREPL,PARITYTYPE," + _
    "PARSE,PARSE$,PARSECOUNT,PBD,PBMAIN,PEEK,PEEK$,PIXELS,POINTER,POKE,POKE$,POPUP,PORT,POST," + _
    "PRESERVE,PRINT,PRINT#,PRIVATE,PROFILE,PROGID$,PTR,PUT,PUT$,QUAD,QWORD,RANDOM,RANDOMIZE,READ," + _
    "READ$,RECEIVE,RECORDS,RECV,REDIM,REDRAW,REGEXPR,REGISTER,REGREPL,REMAIN$,REMOVE$,REPEAT$," + _
    "REPLACE,RESET,RESUME,RET16,RET32,RET87,RETAIN$,RETP16,RETP32,RETPRM,RETURN,RGB,RIGHT," + _
    "RIGHT$,RING,RLSD,RMDIR,RND,ROTATE,ROUND,RSET,RSET$,RTRIM$,RTSFLOW,RXBUFFER,RXQUE,SCAN," + _
    "SCROLLBAR,SDECL,SEEK,SELECT,SEND,SERVER,SET,SETATTR,SETEOF,SGN,SHARED,SHELL," + _
    "SHIFT,SHOW,SIGNED,SIN,SINGLE,SIZE,SIZEOF,SLEEP,SORT,SPACE$,SPC,SQR,STATE,STATIC,STATUS," + _
    "STDCALL,STEP,STOP,STR$,STRDELETE$,STRING,STRING$,STRINSERT$,STRPTR,STRREVERSE$,SUB,SUSPEND," + _
    "SWAP,SWITCH,SWITCH&,SWITCH%,SWITCH$,TAB,TAB$,TAGARRAY,TALLY,TAN,TCP,TEXT,TEXTBOX,THEN," + _
    "THREAD,THREADCOUNT,THREADID,TIME$,TIMEOUT,TIMER,TO,TOGGLE,TRACE,TRIM$,TRN,TRY,TXBUFFER," + _
    "TXQUE,TYPE,UBOUND,UCASE,UCASE$,UCODE$,UDP,UNION,UNITS,UNLOCK,UNTIL,UP,USER,USING,USING$," + _
    "VAL,VARIANT,VARIANT#,VARIANT$,VARIANTVT,VARPTR,VERIFY,VERSION3,VERSION4,VERSION5," + _
    "WEND,WHILE,WIDTH,WIDTH#,WINMAIN,WITH,WORD,WRITE,WRITE#,XOR,XINPFLOW,XOUTFLOW,ZER"
        gKeywords = sLangwords + sKeywords
    end sub
    
    
    
    $Ver = "Ver 0.50"
    
    %IDC_New                  = 102
    %IDC_Show                 = 103
    %IDC_Hlp                  = 108
    %IDC_Statusbar            = 110
    %IDC_Note                 = 201
    %IDC_DEBUG_LB             = 202
    %HASHTABLESIZE            = &H1000
    
    ' the following are used in DIALOG GET/SET USER statements
    ' user dialog user values for communicating with TACE
    %Ptr2UserText       = 1
    %Ptr2Keywords       = 2
    %CCERetval          = 3
    ' dialog user values used internally
    %Hashtab            = 4
    %FREPMSG            = 5
    '----------------------------------------------------------------------------
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' setRichTextColor sets the textcolor for selected text in a RichNote control.
    ' Example: CALL setRichTextColor(&HFF) sets the color to red.
    ' &HFF0000 is blue, &H008000 is dark green, &H0 is black, etc..
    ' ----------------------------------------------------------------------------
    function setRichTextColor( hNote as dword, byval NewColor as long) as long
      local cf as CHARFORMAT
    
      cf.cbSize      = len(cf)       'Length of structure
      cf.dwMask      = %CFM_COLOR    'Set mask to colors only
      cf.crTextColor = NewColor      'Set the new color value
      call SendMessage(hNote, %EM_SETCHARFORMAT, %SCF_SELECTION, varptr(cf))
    
    end function
    '-------------------------------------------------------------------------------
    ' a hashing algo
    function Elf32(sKey as string) as long
      local key as byte ptr
      local h as long
      local g as long
      local i as long
      key = strptr(sKey)
      h = 0
      while @key
        shift left h, 4
        h = h + @key
        key = key + 1
        g = h and &HF0000000???
        if g then
          i = g
          shift right i, 24
          h = h xor i
        end if
        h = h and (not g)
      wend
      function = h
    end function
    '-------------------------------------------------------------------------------
    sub getRichEditText(byval hEd as dword, byval psz as dword)
       local sBuffer as string, ES as EDITSTREAM
    
       es.dwCookie = psz
       es.pfnCallback = codeptr(getRichEditTextCB)
       SendMessage(hEd, %EM_STREAMOUT, %SF_TEXT, byval varptr(es))
    end sub
    '-------------------------------------------------------------------------------
    function getRichEditTextCB(byval dwCookie as dword, byval pRichEd as byte ptr, _
                             byval cb as long, byref pcb as long) as long
       local psBuffer as asciz ptr
       psBuffer = dwCookie
       if cb < 1 then exit function
       @psBuffer = @psBuffer & peek$(pRichEd, cb)
       pcb = cb
    end function
    '-------------------------------------------------------------------------------
    function putRichEditTextCB(byval dwCookie as dword, byval pRichEd as byte ptr, _
                          byval cb as long, byref pcb as long) as long
        'dwCookie used to pass ptr to asciz buffer holding the data to load
        'pRichEd is the ptr to the rich edit control buffer to receive the data
        'cb = bytes to read in chunks (4K) defined by the OS
        'pcb = bytes actually needed to be read (last chunk less than 4K)
        '-------------------------------------------------------------------------
        local psBuffer as asciz ptr
    
        psBuffer = dwCookie
        pcb = min(len(@psBuffer), cb)
        if pcb > 0 then
            poke$ pRichEd, left$(@psBuffer, pcb)
            @psBuffer = mid$(@psBuffer, pcb + 1)
        end if
    end function
    '-------------------------------------------------------------------------------
    function putRichEditText(byval hEd as dword, byval ps as string ptr) as long
    '   '-------------------------------------------------------------------------------
    '   'let rich edit call the callback function repeatedly, reading in 4K chunks
    '   'of data at a time until there is no more to read.
    '   '-------------------------------------------------------------------------------
       local ES as EDITSTREAM
       es.dwCookie    = ps
       es.pfnCallback = codeptr(putRichEditTextCB)
       function = SendMessage(hEd, %EM_STREAMIN, %SF_TEXT, byval varptr(es))  ' %SFF_TEXT
    end function
    '-------------------------------------------------------------------------------
    
    sub saveText( hNote as dword)
        SendMessage hNote, %EM_SETMODIFY, 0, 0
    end sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Syntax color parser for received line numbers
    ' borrowed from Borje Hagsten, much rewritten
    %our_quote = 1
    %our_comment = 2
    %our_word = 3
    %our_other = 4
    ' ----------------------------------------------------------------------------
    sub ScanLine(hNote as dword, byval Line1 as long, byval Line2 as long)
    
        local hUser as dword ' to hold the dialog handle of the user dialog which calls TACE
        local pd as CHARRANGE, Oldpd as CHARRANGE, tBuff as TEXTRANGE
        local szword as asciz * 256 ' to contain a word extracted from line
        local szBuf, sprotobuf as string ' line length propably won't exceed this!
        local openbrkt, Offset, levents, I, J, l, startpos, w as long
        local lnLen, Result, foundmatch, foundword as long
        local Letter as byte ptr
        local prevletter as byte
        local s, sword as string
        local phashtab              as long   ptr
        local pLangWords            as byte ptr
        local pKeyWords             as string ptr
        local sStringQuote, sSingleLineComment, SKeyWords                as string
        local n, ldebug, ldebugsave, lenszbuf    as long
        local tstart as double
        local CharVals()            as long
        dim charvals(0 to 255)
    
        tstart = timer ' debug
        '
        ' charvals : an array in which the index is the ASC value of a character,
        ' and the cell value is the sub index to execute when the char is encountered
        ' in the text being parsed for keywords.
        for n = 0 to 255: charvals(n) = %our_other:next
        '
    '    DIALOG GET USER hNote, %Ptr2Keywords TO pKeyWords
        ' first line is the word delimiters string
        s = parse$(gKeyWords, $crlf,1)
        ' these characters can terminate a "word" in the text being parsed:
        for n = 1 to len( s)
            charvals(asc(mid$(s,n,1))) = %our_word
        next
        ' next single line comment string, NB can be more than 1 char in length.
        ' if it is a single char, just enter it in the char table. If a string, make no
        ' entry in the char table... it is tested inline as a word.
        '
        sSingleLineComment = parse$(gKeyWords, $crlf,2)
        if len( sSingleLineComment) = 1 then charvals(asc(sSingleLineComment)) = %our_comment
        '
        ' next is the string quote char, always a single char
        sStringQuote = parse$(gKeyWords, $crlf,3)
        charvals(asc(sStringQuote)) = %our_quote
        ' rest is the keywords string as a single line
        sKeyWords = ucase$(parse$(gKeyWords, $crlf,4))
        pkeywords = varptr(sKeyWords)
        '
        dialog get user getparent(hNote), %HashTab to phashtab
        '
        call SendMessage(hNote, %EM_EXGETSEL, 0, varptr(Oldpd)) 'Original position
                                                                '(so we can reset it later)
        'Disable the event mask, for better speed
        levents = SendMessage(hNote, %EM_GETEVENTMASK, 0, 0)
        call SendMessage(hNote, %EM_SETEVENTMASK, 0, 0)
    
        SendMessage hNote, %EM_HIDESELECTION,1,0
    
        if Line1 <> Line2 then                                  'if multiple lines
            mouseptr 11
        else                                                                     'editing a line
            pd.cpMin = SendMessage(hNote, %EM_LINEINDEX, Line1, 0)                'line start
            pd.cpMax = pd.cpMin + SendMessage(hNote, %EM_LINELENGTH, pd.cpMin, 0) 'line end
            call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))                  'select line
            setRichTextColor ( hNote, &H0)                                        'set black
        end if
        sprotobuf = string$(500," ")
    
        for J = Line1 to Line2
            szbuf = sprotobuf '+ " "
            Offset = SendMessage(hNote, %EM_LINEINDEX, J, 0)       'line start
            lnLen  = SendMessage(hNote, %EM_LINELENGTH, Offset, 0) 'line length
    
            if lnLen = 0 then iterate
            tBuff.chrg.cpMin = Offset
            ' the extra char is for CR or 1st char of next line if wrapped
            tBuff.chrg.cpMax = Offset + lnLen
            tBuff.lpstrText = strptr(szBuf)
            lnLen = SendMessage(hNote, %EM_GETTEXTRANGE, 0, byval varptr(tBuff)) 'Get line
            szbuf = left$(acode$(szbuf), lnLen)
            call CharUpperBuff(byval strptr(szBuf), lnLen)        'Make UCASE, handles all chars 0-255
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            ' Loop through the line, using a pointer for better speed
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            foundword = 0
            szbuf = szbuf + " " : incr lnLen ' force the last word in the line to be handled inside the loop
            Letter = strptr(szBuf)
            '
    
            for I = 1 to lnLen ' about 5% improvement
                on Charvals(@letter) goto LQUOTE, LCOMMENT, LWORD, LOTHER
    LQUOTE:
                startpos = instr(I + 1, szBuf, sStringQuote)
                if startpos then
                    pd.cpMin = Offset + I
                    pd.cpMax = Offset + startpos - 1
                    call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))  ' was sendmessage
                    setRichTextColor hNote, &HFF
                    startpos = (startpos - I + 1)
                    I = I + startpos
                    Letter = Letter + startpos
                    foundword = 0
                end if
                incr letter
                iterate
    LCOMMENT:
                pd.cpMin = Offset + I - 1
                pd.cpMax = Offset + lnLen
                call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                setRichTextColor hnote, &H00008000&
                foundword = 0
                exit for      ' done with line
    LWORD:
                if foundword = 1 then
                    w = i - startpos
                    szword = mid$(szbuf, startpos, w + 1)
                    poke varptr(szword) + w , 0 ' null terminate!
                    if szword = sSingleLineComment then
                        pd.cpMin = Offset + I - w - 2
                        pd.cpMax = Offset + lnLen
                        call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                        setRichTextColor hnote, &H00008000&
                        foundword = 0
                        exit for
                    end if
    
                    n = elf32(trim$(szword)) mod %HASHTABLESIZE
    
                    foundmatch = %false
                    ldebug = 0
                    do while @phashtab[n] <> 0
                        incr ldebug
                        s = parse$(@pKeyWords, @phashtab[n])
                        if SZWORD <> parse$(@pKeyWords, @phashtab[n]) then
                            if n >= %HASHTABLESIZE then
                                foundmatch = %false
                                exit loop
                            else
                                incr n
                            end if
                        else
                            foundmatch = %TRUE
                            exit loop
                        end if
                    loop
                    if ldebug > ldebugsave then ldebugsave = ldebug
                    if foundmatch = %FALSE then
                        incr letter
                        foundword = 0
                        iterate
                    end if
                    pd.cpMin = Offset + startpos - 1
                    pd.cpMax = Offset + I - 1
                    call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))       ' was sendmessage
                    call setRichTextColor( hnote, &HFF0000)                    'set blue color
                    foundword = 0
                else
                    ' just in case the single line comment is two delimiters like // or --
                    if (@letter = prevletter ) and ((chr$(@letter) + chr$(@letter)) = sSingleLineComment) then
                        pd.cpMin = Offset + I - w - 2
                        pd.cpMax = Offset + lnLen
                        call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                        setRichTextColor hnote, &H00008000&
                        foundword = 0
                        exit for
                    end if
                    prevLetter = @letter
                end if
                incr letter
                iterate
    
    LOTHER:      ' we're inside a word
                if foundword = 0 then
                    startpos = I
                end if
                foundword = 1
                incr Letter
            next I
        next J
    
        'Reset original caret position
        call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(Oldpd))
        SendMessage hNote, %EM_HIDESELECTION,0,0
    
        'Reset the event mask
        if levents then call SendMessage(hNote, %EM_SETEVENTMASK, 0, levents)
    end sub
    '------------------------------------------------------------------------------------
    function MakeFont(byval fName as string, byval ptSize as long, _
                      opt byval attr as string) as dword
       '--------------------------------------------------------------------
       ' Create a desired font and return its handle.
       ' attr = "biu" for bold, italic, and underlined (any order)
       '--------------------------------------------------------------------
       local hDC as dword, CharSet as long, CyPixels as long
       local bold, italic, uLine as long
       if len(attr) then
          if instr(lcase$(attr), "b") then bold = %FW_BOLD
          if instr(lcase$(attr), "i") then italic = 1
          if instr(lcase$(attr), "u") then uLine = 1
       end if
       hDC = GetDC(%hwnd_desktop)
       CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
       ReleaseDC %hwnd_desktop, hDC
       PtSize = 0 - (ptSize * CyPixels) \ 72
       function = CreateFont(ptSize, 0, 0, 0, bold, italic, uLine, _
                 %FALSE, CharSet, %OUT_TT_PRECIS, _
                 %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
                 %FF_DONTCARE , bycopy fName)
    end function
    '-------------------------------------------------------------------------------
    function quitNote( hD as dword, hNote as dword) as long
       local n as long
       function = -1
       if SendMessage(hNote, %EM_GETMODIFY, 0, 0) then ' file has changed
          n = msgbox("Text has changed..." & $crlf _
          & "do you want to save it?", %mb_taskmodal or %mb_yesnocancel or %mb_iconquestion, "Save Text")
          if n = %idcancel then
             function = 0
          else
             if n = %idyes then
                 ' export text
                 function = 1
             end if
          end if
       end if
    end function
    '------------------------------------------------------------------------
    function fileExists(fileName as string) as long
      local n as long
      n = getattr(fileName)
      function = (errclear = 0)
    end function
    '------------------------------------------------------------------------
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<< find & replace code borrowed from Eric Christensen
    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
    '-------------------------------------
    type FINDTEXTEXW
       chrg      as CHARRANGE    ' CHARRANGE chrg
       lpstrText as word ptr     ' LPCWSTR   lpstrText
       chrgText  as CHARRANGE    ' CHARRANGE chrgText
    end type
    '------------------------------------------------------------------
    type FINDTEXTEXW
       chrg      as CHARRANGE    ' CHARRANGE chrg
       lpstrText as word ptr     ' LPCWSTR   lpstrText
       chrgText  as CHARRANGE    ' CHARRANGE chrgText
    end type
    '------------------------------------------------------------------------------------------
    function dofindreplaceaction(byval llparam as long, byval hwnd 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 ptf as textrange ptr
        local buf as string
        local searchflag&, res&
        local n as long
        static s, stemp as string
        local tFT as FINDTEXTEXW
        local ps as asciz ptr
    
        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
        sendmessage hwnd, %em_exgetsel, 0, varptr(cr)
        '
        if (@lppfr.flags and %fr_findnext) then ' find next
            gosub positioncheck
            gosub search
            if isfalse match then ? "no match found",%mb_iconinformation or %mb_taskmodal, "find"
        elseif (@lppfr.flags and %fr_replace) then ' replace
            gosub search
            if istrue match then
                sendmessage hwnd, %em_replacesel, %true, zt2
                cr.cpmax = cr.cpmin + len(@zt2)
                sendmessage hwnd, %em_exsetsel,0, varptr(cr)
                gosub search
                if isfalse match then msgbox "no further match found",%mb_taskmodal or %mb_iconinformation, "find"
            else
                msgbox "no match found",%mb_taskmodal or %mb_iconinformation, "find"
            end if
        elseif (@lppfr.flags and %fr_replaceall) then ' replace all
            gosub search
            if istrue match then
                do
                    sendmessage hwnd, %em_replacesel, %true, zt2
                    cr.cpmax = cr.cpmin + len(@zt2)
                    sendmessage hwnd, %em_exsetsel, 0,  varptr(cr)
                    gosub search
                loop until isfalse match    ' loop until no more matches
            else
                msgbox "no match found",%mb_taskmodal or %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)
            n = 999
            n = sendmessage (hwnd, %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
            tft.chrg.cpmin = cr.cpmin
            tft.chrg.cpmax = sendmessage ( hwnd, %em_getlimittext, 0, 0)
            s = ucode$(@zt)
            ps = strptr(s) 'movememory BYVAL ps, BYVAL STRPTR(s), BYVAL LEN(s) 'UCODE$(@zt),
            tft.lpstrtext  = ps
            '
            ' do specified search for specified text
            ipos = sendmessage (hwnd, %em_findtextexW, %FR_DOWN, varptr(tft)) ' searchflag&
    
            if ipos <> -1 then ' search is successful
                cr.cpmin = ipos
                cr.cpmax = cr.cpmin + len(@zt)
                '
                ' select found text
                sendmessage hwnd, %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
    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> /find & replace code borrowed from Eric Christensen
    '------------------------------------------------------------------------------
    callback function Floatmsg_dialogProc()
    
        select case as long cbmsg
            case %wm_initdialog
            case %wm_command
                dialog end cbhndl, 0
            case %wm_destroy 'delete what we created on exit, to avoid mem leaks
        end select
    end function
    
    '------------------------------------------------------------------------------
    function FloatMsg_dialog(byval hParent as dword, s as string) as long
        local lRslt as long
        local hDlg  as dword
        local p as pointapi
        local x, y, w, h as long
    
        dialog get loc hparent to x, y
        dialog new pixels, hParent, "", x , y , 65, 14, %ws_popup or  _
            %ws_clipsiblings or %ws_visible  or _         ' OR  %DS_NOFAILCREATE OR %DS_3DLOOK OR %WS_THICKFRAME OR
            %ds_setfont, %ws_ex_controlparent or %ws_ex_toolwindow or _
            %ws_ex_topmost or %ws_ex_left or %ws_ex_ltrreading to hdlg
        dialog  set color   hDlg, -1, rgb(255, 255, 155)
        control add label, hDlg, 1001, s, 0, 0, 58, 12, %ss_notify
        control set color hdlg, 1001, -1, -2
        dialog show modeless hDlg, call FloatMsg_dialogProc to lRslt
        function = hdlg
    end function
    
    '----------------------------------------------------------------------------
    function subClassEditProc(byval hWnd as long, byval wMsg&, byval wParm&, byval lparam as long) as long
        local lRet                      as long
        local sztabchar                 as asciz * 2
        local szbuffer                  as asciz * %CCE_MAXTEXTSIZE
        local p                         as PointAPI
        local pdwretval                 as dword ptr
        static psUserTextBuffer         as string ptr
        local curline, l, MenuChoice    as long
        local s, smsg                   as string
        static flgs                     as long ' saving find or replace flags between calls.
        static lPrevSCLN, lSelChangeLineNum as long
        static hMsgFindReplace          as long
        static dwOrigEditProc, hw       as dword
        static InfoDlg                  as dword' handle of Ctrl-G info dialog
        static hpopup                   as dword ' menu handle
        '
        if hWnd& = 0 then           ' initial message from parent
            dwOrigEditProc = wparm&
            hMsgFindReplace = lparam
            function = 1
            exit function
        end if
    
        select case wMsg&
    
            case hMsgFindReplace ' this is the message registered
                smsg = "FINDREPLACE"
                ' do actions in response to your input in the dialog box
                function = dofindreplaceaction(lparam, hWnd, flgs)
                gosub tell
    
            case %wm_vscroll
    
            case %wm_user + 100             ' parent has recieved selchange notification
                if InfoDlg <> 0 then
                    dialog end InfoDlg, 0
                    InfoDlg = 0
                end if
    
                gosub refreshKeyWords
    
            case %wm_keyup
                l = wparm&
                select case wParm&
                   case %VK_TAB
                      sztabchar = chr$(9): SendMessage hWnd, %EM_REPLACESEL, 1, byval varptr(sztabchar)
                end select
    
            case %wm_rbuttonup
                call GetCursorPos(byref p)
                hPopup = CreatePopupMenu ' creating the menu inline to save having to pass the handle back
                                         ' to the main dlg which is where it would logically be destroyed.
                call InsertMenu(hPopup, 0, %MF_BYCOMMAND              , 1, "&Find")
                call InsertMenu(hPopup, 0, %MF_BYCOMMAND              , 2, "&Done")
                MenuChoice = TrackPopupMenuEx(hPopup, %mf_enabled or %MF_BYCOMMAND or %TPM_RETURNCMD, p.x, p.y, _
                             getparent(hWnd), byval %NULL)
    
                destroymenu ( hpopup)
                control get user getparent(hwnd), %IDC_NOTE, %CCERetVal to pdwretval
                select case menuchoice
                    case 1 ' find
                        call openfindorreplacetextdialog(hWnd, 1, flgs)
                    case 2 ' replace
                        call openfindorreplacetextdialog(hWnd, 2, flgs)
                    case 3 ' done
                        hw = getparent(hwnd)
                        getRichEditText( hWnd, byval varptr(szbuffer))
                        @pdwretval = 1
                        dialog end getparent(hWnd), 0
                    case 4 ' Cancel
                        @pdwretval = 0
                        dialog end getparent(hWnd), 0
                end select
    
            case %wm_char
                 if InfoDlg <> 0 then
                     dialog end InfoDlg, 0
                     InfoDlg = 0
                 end if
                 select case wParm&
                     case &H16 ' have we been pasted with CTL-V ?
                         smsg = "CTRL-V"
                         scanline  hWnd, lPrevSCLN, lSelChangeLineNum
                end select
    
            case %WM_GETDLGCODE
                if isfalse lparam then 'not a message being sent to the control
                    ' Ensure that the edit control does not select its contents on receiving the focus
                    lRet = CallWindowProc(dwOrigEditProc, hWnd, wMsg&, wParm&, lparam)
                    function = lRet xor %dlgc_hassetsel 'Clear the DLGC_HASSETSEL bit from lRet
                    exit function
                end if
    
        end select
        ' Pass the message on to the original window procedure
        function = CallWindowProc(dwOrigEditProc, hWnd, wMsg&, wParm&, lparam)
        exit function
    '
    refreshKeyWords:
        lPrevSCLN = lSelChangeLineNum
        lSelChangeLineNum = SendMessage(hWnd, %EM_EXLINEFROMCHAR, 0, -1)
    return
    '
    tell:
        return
    end function
    '----------------------------------------------------------------------------
    callback function showNoteProc()
        local fontSize, hpopup, i, l, linecount, menuchoice, wi, ht, tabunits as long
        local fontName, fn, s           as string
        static sbuffer                  as string
        static szbuffer                 as asciz * %CCE_MAXTEXTSIZE ' define the max buffer size for CCE
        local pmmi                      as MINMAXINFO ptr
        local p                         as PointAPI
        local pnmh                      as nmhdr ptr
        static flgs                     as long ' saving find or replace flags between calls.
        local CurLine                   as long  ' ephemeral current line position
        static hNote                    as dword
        local  pKeyWords                as string ptr     ' slangwords
        static lhashtab()               as long
        static lUboundCData             as long
        static szReqdchars              as asciz * 256
        static hMsgFindReplace          as long
        static dwOrigEditProc           as dword
        static  psUserTextBuffer        as asciz ptr
        local  dwInitProc               as long
        local pdw                       as dword ptr
        local huser                     as dword ' handle of user dialog which called TACE
        static hfont                    as dword ' font for editor window
        local h                         as dword
    
        select case cbmsg
          case %wm_initdialog
    
              redim lhashtab(0 to %HASHTABLESIZE -1) as static long ' %HASHTABLESIZE -1
              ' register a message for the find or replace dialog.
              hMsgFindReplace = registerwindowmessage ("commdlg_findreplace")
              dialog set user cbhndl, %Frepmsg, hMsgFindReplace
              gosub loaddata
              ' set pointer to KeyWords array as a property of this window
              dialog set user cbhndl, %Hashtab, varptr(lhashtab(0))
              '------------------------------------------------------------------
              ' resize dialog to show vertical scrollbar
              '------------------------------------------------------------------
              control handle cbhndl, %IDC_Note to hNote
              dialog get client cbhndl to wi, ht
              dialog set size cbhndl, wi, ht
    
              '------------------------------------------------------------------
              ' create and set an initial fixed-width font as default
              '------------------------------------------------------------------
              fontName = "Courier New": fontSize = 10
              hFont = MakeFont(fontName, fontSize)
              SendMessage hNote, %WM_SETFONT, hFont, 0
    
              tabUnits = 16 'interval of 8 spaces
              SendMessage hNote, %EM_SETTABSTOPS, 1, byval varptr(tabUnits)
              SendMessage hNote, %EM_LIMITTEXT, %CCE_MAXTEXTSIZE, 0
              SendMessage hNote, %EM_SETOPTIONS, %ECOOP_OR, %ECO_SELECTIONBAR 'left margin selection
              SendMessage hNote, %EM_FMTLINES, %TRUE, 0
              '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              'Must set the event mask, so we can pick up a few events from RichNote
              '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              call SendMessage(hNote, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE or %ENM_CHANGE or %ENM_UPDATE)
              dwOrigEditProc = SetWindowLong(hNote, %GWL_WNDPROC, codeptr(subClassEditProc)) 'subclass
              ' call the subclassed control directly
              ' to tell it what it's original WndProc is
              ' and what the find/replace message number is
              subClassEditProc ( 0, 0, dwOrigEditProc, hMsgFindReplace)
              SendMessage hNote, %EM_SETMODIFY, 0, 0
              h = cbhndl ' debug
              control get user cb.hndl, %IDC_Note, %Ptr2UserText to psUserTextBuffer
              szbuffer = space$(%CCE_MAXTEXTSIZE)
              szbuffer = @psUserTextBuffer
              putRichEditText( hNote, byval varptr(szbuffer)) 'hWnd, string ptr
              CurLine = SendMessage(hNote, %EM_getlinecount, 0, 0)
              call ScanLine(hnote, 0, CurLine)
    
            case %wm_size
              RedrawWindow cbhndl, byval 0, byval 0, %RDW_VALIDATE
              dialog get client cbhndl to wi, ht
              control set size cbhndl, %IDC_Note, wi, ht
              RedrawWindow cbhndl, byval 0, byval 0, %RDW_INVALIDATE
    
           case %WM_GETMINMAXINFO
               pmmi = cblparam
               @pmmi.ptMinTrackSize.x = 200  'minimum size of window
               @pmmi.ptMinTrackSize.y = 200
    
           case %wm_command
               select case cbctl
                   case %IDC_NOTE
                       select case hiwrd(cbwparam)   'show you where to find them
                           case %en_update 'is trigged before displaying altered text
                           case %en_change 'is trigged after..
                               CurLine = SendMessage(hNote, %EM_EXLINEFROMCHAR, 0, -1)
                               call ScanLine(hnote, CurLine, CurLine)
                       end select
              end select
    
           case %wm_notify
               select case cbctl
                   case %IDC_NOTE
                       pnmh = cblparam
                       select case @pnmh.code
                           case %EN_SELCHANGE
                               sendmessage hNote, %wm_user + 100, 0, 0
                       end select
               end select
    
            case %WM_SETTEXT  ' assume that this is the initial data load of the edit control
                control send cbhndl, %IDC_note, %WM_SETTEXT, cbwparam, cblparam
            '
            case %wm_user + 201  ' user shut down - drop everything & close
                control kill cbhndl, %IDC_NOTE
                dialog end cbhndl, 0
            '
            case %wm_user + 202  ' maximize window
                dialog show state cbhndl,  %sw_show
            '
            case %wm_destroy
                ' remove subclassing
                SetWindowLong hNote, %GWL_WNDPROC, dwOrigEditProc
                DeleteObject hFont
                FreeLibrary ghLib
    
        end select
        exit function
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    loaddata:
        local hfile as long
        local n as long
    
        ' keywords string has 3 lines of non-keywords at start, strip these
        n = parsecount(gKeywords, $crlf)
        s = ucase$(parse$(gKeyWords,$crlf,4))
        '
        n = parsecount(s)
        for i = 0 to n -1
            h = elf32(parse$(s, i)) mod %HASHTABLESIZE
            while lhashtab(h)<> 0: incr h: wend
            lhashtab(h) = i
        next
    return
    end function
    '-------------------------------------------------------------------------------------------
    ' params are parent window coordinates for edit window, text ptr, title
    function CCE_BASRO ( hParent as dword, r as rect, byval pstext as dword, Title as string) as long
    
        local nStyle, bStyle as long
        local dwresult as dword ' to contain the result from the CB function
        local dwretval              as dword
        local hDlg as dword
        static s as string
    
        local debug1, debug2 as string ptr
    
        CreatePBKeyWordString ' create global keywords string
        ghLib = LoadLibrary("Msftedit.dll") 'Riched32.dll")
    '    hLib = LoadLibrary("Riched20.dll")
        if ghLib = 0 then
           s = "File 'Msftedit.dll' required"
           msgbox s, %mb_taskmodal or %mb_iconwarning, "File not Found": exit function
        end if
        ghLib = 0
        nStyle = %ws_child or %ws_popup or %ws_sysmenu or %ws_minimizebox or %ws_maximizebox or _
                 %ds_center or %ds_modalframe or %ws_thickframe or %ws_caption
    
        dialog new pixels, 0, Title, r.nleft, r.ntop, r.nright, r.nbottom, nStyle to hDlg
        '
        nStyle = %ws_child  or %ws_clipchildren or %ws_visible or %es_multiline _
               or %ws_vscroll or %es_autovscroll  or %ws_hscroll  or %es_autohscroll or %es_wantreturn _
               or %ws_tabstop  or %es_nohidesel    ' or %ES_NOIME
    
        control add "RichEdit50W", hDlg, %IDC_Note, "", 0, 0, r.nright, r.nbottom, nStyle
        control set user hdlg, %IDC_NOTE, %Ptr2UserText, pstext
    
        ' send our dialog & editor control hwnd to parent
        dialog send hparent, %wm_user + 500, hdlg, %IDC_NOTE
        ' set edit window to Read Only
        control send hDlg, %IDC_Note, %EM_SETREADONLY, 1, 0
        dialog show modeless hDlg, call ShowNoteProc to dwresult
    end function
    Last edited by Chris Holbrook; 14 Sep 2009, 08:06 AM.

    Comment


    • #3
      new version - see top of code for changes

      discussion here: http://www.powerbasic.com/support/pb...379#post323379

      main application file F2Plus.bas
      Code:
      '
      ' Experimenting with a function/sub list for a code module
      ' starting off with a basic function list like the F2 list in the PB compilers
      ' Each function or sub can be viewed in a seperate window
      ' Synchronises with the last saved version of the subject file by checking the directory entry
      ' of the target file and reloading the function index and any changed windows
      '
      ' Chris Holbrook 12-Sep-2009
      '
      ' Changes
      ' 13-SEP-2009 includes comments preceding sub/function header in the function viewer windows
      ' 13-SEP-2009 uses keyword, comment and literal coloring
      ' 14-SEP-2009 added tooltips to controls on main screen
      ' 14-SEP-2009 added source file name to main dialog title
      ' 15-SEP-2009 fixed GPF problem
      ' 15-SEP-2009 only a single source code file can be examined by a single instance of the application
      '
      ' Issues list (* = incorporated in change)
      ' 13-SEP-2009 PB keyword list is for PBWin V7 only
      ' 14-SEP-2009 refreshes all viewer windows when any change occurs, not just the changed ones.
      ' 14-SEP-2009 * Charles Dietz & Artur Gomide report GPFs - cannot recreate
      '
      ' to do list (* = incorporated in change)
      ' 15-SEP-2009 Gösta H. Lovgren-2 suggests making the function list sortable
      ' 15-SEP-2009 Gösta H. Lovgren-2 suggests including macros
      ' 15-SEP-2009 * Gösta H. Lovgren-2 suggests making the initial screen larger
      ' 15-SEP-2005 Add a viewer window containing all globals
      ' 15-SEP-2005 Add a viewer window containing all variable declarations
      ' 15-SEP-2005 Add a viewer window containing all TYPE declarations
      ' 15-SEP-2005 Add a viewer window containing the code before the first function/macro declaration
      '
      #compile exe
      '#debug display
      #dim all
      
      #if not %def(%WINAPI)
          #include "WIN32API.INC"
      #endif
      #if not %def(%COMMCTRL_INC)
          #include "COMMCTRL.INC"
      #endif
      #if not %def(%COMDLG32_INC)
          #include "COMDLG32.INC"
      #endif
      #include "richedit.inc"
      #include "c:\chris\edit\CCE_BASRO.INC"
      $version = "0.1.2"
      %IDD_DIALOG1         =  101
      %IDC_LV = 1001
      %IDD_DIALOG2         =  102
      %IDC_TEXTBOX1        = 1003
      %IDC_SOUFILE_BN      = 1004
      
      type tfindex
          sfname as asciz * 256
          start as long
          finish as long
          hwnd as dword
      end type
      global findex() as tfindex      ' global table of functions and subs
      global sourcecode() as string   ' global table of source code
      global ghfont as dword          ' font
      global gOutputHandle as dword
      '-----------------------------------------------------------------------------
      sub StopConsole
          if gOutputHandle = 0 then exit sub
          Freeconsole
      end sub
      '-----------------------------------------------------------------------------
      sub startconsole
          Allocconsole
          gOutputHandle = getstdhandle ( %STD_OUTPUT_HANDLE)
      end sub
      '-----------------------------------------------------------------------------
      sub Conout ( s as string)
          local lpreserved as dword
          local n as long
      
          if gOutputHandle = 0 then exit sub
          WriteConsole( gOutputHandle, byval strptr(s), len(s), byval varptr(n), lpReserved)
      end sub
      '-----------------------------------------------------------------------------
      global hWndToolTip  as dword
      '-----------------------------------------------------------------
      sub CreateTip( hDlg as dword, tl as dword, Tip as string )
      static Crt          as CREATESTRUCT
      static TlInfo       as TOOLINFO
      static hInst        as long
      
          if hWndToolTip then 'it's been initialized
      
              if tl = 0 then exit if
              'Tip = Left$(Tip, 79)
              control handle hDlg, tl to tl
              TlInfo.hwnd = tl
              TlInfo.uId = tl
              TlInfo.lpszText = strptr(Tip)
              SendMessage( hWndToolTip, %TTM_ADDTOOL, 0, varptr( TlInfo ) )
              SendMessage( hWndToolTip, %TTM_ACTIVATE, 1, 0 )
      
          else 'just initializing this time through
              local ice as INIT_COMMON_CONTROLSEX
              ice.dwSize = sizeof(ice)
              ice.dwICC = %ICC_WIN95_CLASSES
              InitCommonControlsEx(ice)
      
              hInst = GetModuleHandle("")
              Tip = "ToolTip"
              Crt.lpCreateParams = 0
              Crt.hInstance    = hInst
              Crt.hMenu        = 0
              Crt.hwndParent   = hDlg
              Crt.style        = %ws_popup or %TTS_NOPREFIX or %TTS_ALWAYSTIP
              Crt.lpszName     = strptr(Tip)
              Tip = $TOOLTIPS_CLASS
              Crt.lpszClass    = strptr(Tip)
              Crt.dwExStyle    = %ws_ex_topmost
      
              hWndToolTip = CreateWindowEx( %ws_ex_topmost, $TOOLTIPS_CLASS, "", _
              %ws_popup or %TTS_NOPREFIX or %TTS_ALWAYSTIP or %TTS_BALLOON, _
                  %CW_USEDEFAULT, %CW_USEDEFAULT, %CW_USEDEFAULT, _
                  %CW_USEDEFAULT, hDlg, 0, hInst, Crt )
      
      
              dialog send hWndToolTip, %TTM_SETMAXTIPWIDTH, 0, 200
      
              SetWindowPos( hWndToolTip, %HWND_TOPMOST, 100, 100, 300, 300, _
                  %SWP_NOMOVE or %SWP_NOSIZE or %SWP_NOACTIVATE )
      
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_INITIAL, 100 ) 'time a pointer must remain stationary before the tooltip appears
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 7000 ) 'time a tooltip window remains visible If the Pointer is stationary
              SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_RESHOW, 400 ) 'time before subsequent tooltips to appear
      
              '------------------------------
              TlInfo.cbSize = sizeof( TOOLINFO )
              'this doesn't make sense, but it works
              TlInfo.uFlags = %TTF_SUBCLASS or %TTS_ALWAYSTIP or %TTS_BALLOON or %TTF_CENTERTIP
              'if hToolParWnd <> 0 then tl is a control ID instead of a window handle
              TlInfo.hinst = hInst
      
          end if 'hWndToolTip
      
      end sub 'CreateTip
      
      '-------------------------------------------------------------------------------------------------------------
      sub SetToolTips(hDlg as dword)
      static  f   as long
      
          if f then exit sub else incr f 'make sure it only runs once
              CreateTip hDlg, 0, ""     'initialize tooltips
              CreateTip hDlg, %IDC_LV, "Click a function in the listview to see the source code in a new window"
              CreateTip hDlg, %IDC_SOUFILE_BN, "Click here to chose a new source file"
      end sub 'SetToolTips
      
      '---------------------------------------------------------------------------
      function build ( hD as dword, LVid as long, sfile as string) as long
          local i, j, n, hfile, nrow, linenum as long
          local s, sline, s1, s2, s3, slist, swork as string
      '
          hfile = freefile
          try
              open sfile for input as hfile
              linenum = 1
              while isfalse eof(hfile)
                  line input #hfile, sline
                  n = ubound(sourcecode()) + 1
                  redim preserve sourcecode(0 to n)
                  sourcecode(n) = sline
                  incr linenum
              wend
              close hfile
          catch
              dialog set text hd, "FILE ERROR": beep: sleep 2000
              exit function
          end try
          ' pick out functions & subs from the array
          for i = lbound(sourcecode()) to ubound(sourcecode())
              SWORK = Sourcecode(i) + " @@@@@@@@"
              s1 = ucase$(parse$(ltrim$(swork), " ", 1))
              s2 = parse$(ltrim$(swork), any " (", 2)
              s3 = parse$(ltrim$(swork), any " (", 3)
              select case s1
                  case "SUB"
                      gosub addtolist
                  case "FUNCTION"
                      if left$(s2,1) <> "=" then gosub addtolist
                  case "CALLBACK"
                      gosub addtolist
                  case "END"
                      if ucase$(left$(s2,8)) = "FUNCTION" then
                          gosub nudgelist
                          exit select
                      end if
                      if ucase$(left$(s2,3)) = "SUB" then
                          gosub nudgelist
                      end if
              end select
          next
      
          s = ""
          exit function
      '''''''''''''''
      addtolist:
          incr nrow
          j = 1
          do while (i-j) > 0
              s = ltrim$(sourcecode(i - j))
              if left$(ltrim$(s),1) = $sq then
                  incr j
              else
                  exit loop
              end if
          loop
          if s1 = "CALLBACK" then
              s = s3
          else
              s = s2
          end if
          listview insert item hD, %IDC_LV, nrow, 0, s
          redim preserve findex(1 to nrow)
          findex(nrow).start = i - j + 1
          findex(nrow).sfname = s'sourcecode(i)
          if nrow > 1 then
              if findex(nrow -1).finish = 0 then
                  findex(nrow-1).finish = i -1
              end if
          end if
          listview set text hD, %IDC_LV, nrow, 2, sourcecode(i)
      return
      '''''''''''''''
      nudgelist:
          findex(nrow).finish = i
      return
      end function
      '--------------------------------------------------------
      callback function MainDlgProc()
          local i, j, l, n, nfrom, nto, nsel, x, y as long
          local s, soldcode, spath as string
          ' temporary array into which the old findex array is copied
          ' when a dirent change is detected
          local prevfindex() as tfindex
          ' rect used to define CCE window
          local r as rect
      
          ' used in checking the dirent for updates
          static htimer as dword
          ' filename and dialog title
          static sourcecodefile, stitle as string
          ' used in checking the dirent for updates
          static dird, dird1 as dirdata
          '
          select case as long cbmsg
              case %wm_initdialog
                  'startconsole
                  conout ("init")
                  settooltips ( cb.hndl)
                  listview set stylexx cb.hndl, %IDC_LV, _
                      %LVS_ex_infotip or %LVS_EX_FULLROWSELECT or  %LVS_EX_ONECLICKACTIVATE or %LVS_EX_GRIDLINES
                  listview reset cb.hndl, %IDC_LV
                  listview  insert column cb.hndl, %IDC_LV, 1, "Name", 100, 0
                  listview  insert column cb.hndl, %IDC_LV, 2, "header", 500, 0
                  stitle = "F2+ Source Code File Selection"
                  gosub setsourcecodefile
              '
              case %wm_destroy
                  conout ("destroy")
                  killtimer cb.hndl, htimer
                  if ubound(findex()) < 0 then exit select
                  for i = lbound(findex()) to ubound(findex())
                      if findex(i).hWnd <> 0 then
                          dialog end findex(i).hWnd, 0
                      end if
                  next
                  stopconsole
              '
              case %wm_timer
                  conout ("timer")
                  s = dir$ (sourcecodefile to dird1)
                  if dird1.LastWriteTime <> dird.lastwritetime then
                      erase sourcecode() ' get rid of the previous sourcecode array
                      dird = dird1
                      listview reset cb.hndl, %IDC_LV
                      l = lbound(findex())
                      dim prevfindex(l to ubound(findex()))
                      poke$ varptr(prevfindex(l)), peek$(varptr(findex(l)),sizeof(findex(l)) * arrayattr(findex(),4))
                      erase findex()
                      build(cb.hndl, %IDC_LV, sourcecodefile)
                      for i = lbound(findex()) to ubound(findex())
                           if prevfindex(i).hWnd then
                               ' get the text in the "new" file for the named Function
                               ' kill off viewer window
                               dialog end prevfindex(i).hWnd, 0
                               s = trim$(prevfindex(i).sfname)
                               listview find exact cb.hndl, %IDC_LV, 1, s to n
                               ' if the function no longer exists, no further action required
                               if n = 0 then exit select
                               ' fn is present, create a new window
                               s = ""
                               for j = findex(i).start to findex(i).finish
                                   s = s + $crlf + sourcecode(j)
                               next
                               s = mid$(s, 3) ' lose leading $crlf
                               stitle = findex(i).sfname + " in " + sourcecodefile + " " + time$
                               setrect r, 0, 0, 400, 300
                               findex(i).hWnd = CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                           end if
                      next
                  end if
              '
              case %wm_user + 501 ' child dialog has ended - clear hWnd in findex table
                  conout ("501")
                  for i = lbound(findex()) to ubound(findex())
                      if findex(i).hWnd = cb.wparam then
                          findex(i).hWnd = 0
                          exit for
                      end if
                  next
              '
              case %wm_move, %wm_size
                  conout ("movesize")
      
                  local xx, yy as long
                  if cb.wparam = %SIZE_MINIMIZED then
                      for i = lbound(findex()) to ubound(findex())
                          if findex(i).hWnd <> 0 then
                              dialog send findex(i).hWnd, %wm_syscommand, %sc_minimize, 0
                          end if
                      next
                  end if
                  dialog get client cb.hndl to x, y
                  control set size cb.hndl, %IDC_LV, x, y -25
                  control get size cb.hndl, %IDC_SOUFILE_BN to xx, yy
                  control set size cb.hndl, %IDC_SOUFILE_BN, x, yy
              '
              case %wm_notify
                  conout ("notify")
      
                  select case cb.ctl
                      case %IDC_LV
                          select case cb.nmcode
                              case %nm_click
                                  listview get select cb.hndl, %IDC_LV to nsel
                                  if nsel > ubound(findex()) then
                                      ? "selected item above expected range"
                                      exit select
                                  end if
                                  if nsel < lbound(findex()) then
                                      ? "selected item below expected range"
                                      exit select
                                  end if
      
                                  nfrom = findex(nsel).start
                                  nto   = findex(nsel).finish
                                  for i = findex(nsel).start to findex(nsel).finish
                                      s = s + $crlf + sourcecode(i)
                                  next
                                  s = mid$(s,3)
                                  stitle = findex(nsel).sfname + " in " + sourcecodefile + " " + time$
                                  setrect r, 0, 0, 400, 300
                                  findex(nsel).hWnd = CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                          end select
                  end select
              '
              case %wm_command
                  conout ("command")
      
                  select case cb.ctl
                      case %IDC_SOUFILE_BN
                          gosub setsourcecodefile
                  end select
              '
      '        case %wm_ncrbuttondown
      '            for i = lbound(findex()) to ubound(findex())
      '                 s = s + str$(findex(i).start) + str$(findex(i).finish) + " " + findex(i).sfname + $crlf
      '            next
      '            ?s
              '
              case %wm_ncactivate
                  static hWndSaveFocus as dword
                  if isfalse cbwparam then
                      hWndSaveFocus = GetFocus()
                  elseif hWndSaveFocus then
                      SetFocus(hWndSaveFocus)
                      hWndSaveFocus = 0
                  end if
          end select
          exit function
      ''''''''''''''''''''''
      setsourcecodefile:
          local sfname as string
          spath = curdir$
          OpenFileDialog(cb.hndl, stitle, sourcecodefile, sPATH, _
              "Basic Source Code Files|*.bas|Include Files|*.inc|All Files|*.*", "txt", 0)
          control set text cb.hndl, %IDC_SOUFILE_BN, sourcecodefile
          sfname = parse$(sourcecodefile,"\",-1)
          dialog set text cb.hndl, "F2+ " + sfname
          if ubound(findex) > -1 then
              for i = lbound(findex()) to ubound(findex())
                  if findex(i).hWnd then dialog end findex(i).hWnd, 0
              next
          end if
          erase findex()
          erase sourcecode()
          s = dir$ (sourcecodefile to dird)
          listview reset cb.hndl, %IDC_LV
          build(cb.hndl, %IDC_LV, sourcecodefile)
          htimer = settimer ( cb.hndl,%null, 2000, %null)
      return
      end function
      '------------------------------------------------------------------------
      function MainDlg(byval hParent as dword) as long
          local lRslt, w, h as long
          local hDlg  as dword
      
          dialog font default "Courier New", 10, 0, 0
          dialog new hParent, "F2+", 0, 0, 201, 321, _
              %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or %ws_minimizebox or _
              %ws_clipsiblings or %ws_visible or %ds_modalframe or %ds_3dlook or _
              %ds_nofailcreate or %ds_setfont or %ds_center or %ws_thickframe, _
              %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _
              to hDlg
          dialog get client hDlg to w, h
          control add button, hDlg, %IDC_SOUFILE_BN, "source code file", 0, 0, w, 14
          control add "SysListView32", hDlg, %IDC_LV, "SysListView32_1", 0, 15, 192, 100, _
              %ws_child or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways, _
              %ws_ex_left or %ws_ex_clientedge or %ws_ex_rightscrollbar
          dialog show modal hDlg, call MainDlgProc to lRslt
          function = lRslt
      end function
      '---------------------------------------------------------------------
      function pbmain()
          initcommoncontrols
          MainDlg %hwnd_desktop
      end function
      Viewer Include file CCE_BASRO.inc
      Code:
      '------------------------------------------------------------------------------------------------------
      ' COMPACT CODE EDITOR CCE.INC
      ' Chris Holbrook July 2008
      ' including some code by Charles Dietz, Eric Christensen and Borje Hagsten
      ' modified to use with F2plus application
      '
      
      ' CHANGES
      ' 13-SEP-2009 subset for RO PB Code viewing
      ' 15-SEP-2009 CCE_BASRO now returns viewer dialog handle to caller
      '============================================
      
      
      %CCE_MAXTEXTSIZE = 32768
      global gKeywords as string
      global ghlib as dword
      '--------------------------------------------------------------------------------------
      'PBWin 7.0 syntax color data - think at least most of it..  :-)
      '----------------------------------------------------------------------------
      '
      sub CreatePBKeyWordString
          local hfile as long
          local s as string
          static slangwords, skeywords as string
      
          sLangWords = " ,=-+*/\(;" + $crlf + _
                       "'"         + $crlf + _
                       $dq          + $crlf
          sKeyWords = _
      "#BLOAT,#COMPILE,#DEBUG,#DIM,#ELSE,#ELSEIF,#ENDIF,#IF,#INCLUDE,#OPTION,#REGISTER,#RESOURCE," + _
      "#SEGMENT,#STACK,#TOOLS,$BEL,$BS,$COMPILE,$CR,$CRLF,$DEBUG,$DIM,$DQ,$ELSE,$ELSEIF,$ENDIF," + _
      "$EOF,$ESC,$FF,$IF,$INCLUDE,$LF,$NUL,$OPTION,$REGISTER,$RESOURCE,$SEGMENT,$SPC,$STACK," + _
      "$TAB,$VT,%DEF,%FALSE,%NULL,%PB_EXE,%TRUE," + _
      "ABS,ACCEL,ACCEPT,ACCESS,ACODE$,ADD,ADDR,ALIAS,ALL,AND,ANY,APPEND,ARRAY,ARRAYATTR," + _
      "AS,ASC,ASCEND,ASCIZ,ASCIIZ,AT,ATN,ATTACH,ATTRIB,BAR,BASE,BAUD,BDECL,BEEP," + _
      "BIN$,BINARY,BIT,BITS%,BITS&,BITS?,BITS??,BITS???,BREAK,BUTTON,BYCMD,BYCOPY,BYREF," + _
      "BYTE,BYVAL,CALC,CALL,CALLBACK,CALLSTK,CALLSTK$,CALLSTKCOUNT,CASE,CATCH,CBCTL,CBCTLMSG," + _
      "CBHNDL,CBLPARAM,CBMSG,CBWPARAM,CBYT,CCUR,CCUX,CD,CDBL,CDECL,CDWD,CEIL,CEXT,CHDIR," + _
      "CHDRIVE,CHECK,CHECK3STATE,CHECKBOX,CHOOSE,CHOOSE&,CHOOSE%,CHOOSE$,CHR$,CINT,CLIENT,CLNG," + _
      "CLOSE,CLS,CLSID$,CODEPTR,COLLATE,COLOR,COLUMN,COMBOBOX,COMM,COMMAND$,CON,CONNECT,CONST,CONTROL," + _
      "COS,CQUD,CREATE,CSET,CSET$,CSNG,CTSFLOW,CUR,CURDIR$,CURRENCY,CURRENCYX,CUX,CVBYT,CVCUR," + _
      "CVCUX,CVD,CVDWD,CVE,CVI,CVL,CVQ,CVS,CVWRD,CWRD,DATA,DATACOUNT,DATE$,DECLARE,DECR,DEFAULT," + _
      "DEFBYT,DEFCUR,DEFCUX,DEFDBL,DEFDWD,DEFEXT,DEFINT,DEFLNG,DEFQUD,DEFSNG,DEFSTR,DEFWRD,DELETE," + _
      "DESCEND,DIALOG,DIM,DIR$,DISABLE,DISKFREE,DISKSIZE,DISPATCH,DLL,DLLMAIN,DO,DOEVENTS,DOUBLE," + _
      "DOWN,DRAW,DSRFLOW,DSRSENS,DTRFLOW,DTRLINE,DWORD,ELSE,ELSEIF,EMPTY,ENABLE,END,ENVIRON$," + _
      "EOF,EQV,ERASE,ERR,ERRAPI,ERRCLEAR,ERROR,ERROR$,EXE,EXIT,EXP,EXP10,EXP2,EXPLICIT,EXPORT," + _
      "EXT,EXTENDED,EXTRACT$,FILEATTR,FILECOPY,FILENAME$,FILESCAN,FILL,FINALLY,FIX,FLOW,FLUSH,FOCUS," + _
      "FONT,FOR,FORMAT$,FORMFEED,FRAC,FRAME,FREEFILE,FROM,FUNCTION,FUNCNAME$,GET,GET#,GET$," + _
      "GETATTR,GLOBAL,GOSUB,GOTO,GUID$,GUIDTXT$,HANDLE,HEX$,HIBYT,HIINT,HIWRD,HOST,ICASE,ICON," + _
      "IDN,IF,IFACE,IIF,IIF&,IIF%,IIF$,IMAGE,IMAGEX,IMGBUTTON,IMGBUTTONX,IMP,IN,INCR,INP,INOUT," + _
      "INPUT,INPUT#,INPUTBOX$,INSERT,INSTR,INT,INTERFACE,INTEGER,INV,ISFALSE,ISNOTHING," + _
      "ISOBJECT,ISTRUE,ITERATE,JOIN$,KILL,LABEL,LBOUND,LCASE$,LEFT,LEFT$,LEN,LET,LIB,LIBMAIN," + _
      "LINE,LISTBOX,LISTVIEW,LOBYT,LOC,LOCAL,LOCK,LOF,LOG,LOG10,LOG2,LOINT,LONG,LOOP,LOWRD,LPRINT," + _
      "LSET,LSET$,LTRIM$,MACRO,MACROTEMP,MAIN,MAKDWD,MAKINT,MAKLNG,MAKPTR,MAKWRD,MAT,MAX,MAX$," + _
      "MAX%,MAX&,MCASE$,MEMBER,MENU,MID$,MIN,MIN$,MIN%,MIN&,MKBYT$,MKCUR$,MKCUX$,MKD$," + _
      "MKDIR,MKDWD$,MKE$,MKI$,MKL$,MKQ$,MKS$,MKWRD$,MOD,MODAL,MODELESS,MOUSEPTR,MSGBOX," + _
      "NAME,NEW,NEXT,NONE,NOT,NOTHING,NOTIFY,NULL,OBJACTIVE,OBJECT,OBJPTR,OBJRESULT,OCT$,OF," + _
      "OFF,ON,OPEN,OPT,OPTION,OPTIONAL,OR,OUT,OUTPUT,PAGE,PARITY,PARITYCHAR,PARITYREPL,PARITYTYPE," + _
      "PARSE,PARSE$,PARSECOUNT,PBD,PBMAIN,PEEK,PEEK$,PIXELS,POINTER,POKE,POKE$,POPUP,PORT,POST," + _
      "PRESERVE,PRINT,PRINT#,PRIVATE,PROFILE,PROGID$,PTR,PUT,PUT$,QUAD,QWORD,RANDOM,RANDOMIZE,READ," + _
      "READ$,RECEIVE,RECORDS,RECV,REDIM,REDRAW,REGEXPR,REGISTER,REGREPL,REMAIN$,REMOVE$,REPEAT$," + _
      "REPLACE,RESET,RESUME,RET16,RET32,RET87,RETAIN$,RETP16,RETP32,RETPRM,RETURN,RGB,RIGHT," + _
      "RIGHT$,RING,RLSD,RMDIR,RND,ROTATE,ROUND,RSET,RSET$,RTRIM$,RTSFLOW,RXBUFFER,RXQUE,SCAN," + _
      "SCROLLBAR,SDECL,SEEK,SELECT,SEND,SERVER,SET,SETATTR,SETEOF,SGN,SHARED,SHELL," + _
      "SHIFT,SHOW,SIGNED,SIN,SINGLE,SIZE,SIZEOF,SLEEP,SORT,SPACE$,SPC,SQR,STATE,STATIC,STATUS," + _
      "STDCALL,STEP,STOP,STR$,STRDELETE$,STRING,STRING$,STRINSERT$,STRPTR,STRREVERSE$,SUB,SUSPEND," + _
      "SWAP,SWITCH,SWITCH&,SWITCH%,SWITCH$,TAB,TAB$,TAGARRAY,TALLY,TAN,TCP,TEXT,TEXTBOX,THEN," + _
      "THREAD,THREADCOUNT,THREADID,TIME$,TIMEOUT,TIMER,TO,TOGGLE,TRACE,TRIM$,TRN,TRY,TXBUFFER," + _
      "TXQUE,TYPE,UBOUND,UCASE,UCASE$,UCODE$,UDP,UNION,UNITS,UNLOCK,UNTIL,UP,USER,USING,USING$," + _
      "VAL,VARIANT,VARIANT#,VARIANT$,VARIANTVT,VARPTR,VERIFY,VERSION3,VERSION4,VERSION5," + _
      "WEND,WHILE,WIDTH,WIDTH#,WINMAIN,WITH,WORD,WRITE,WRITE#,XOR,XINPFLOW,XOUTFLOW,ZER"
          gKeywords = sLangwords + sKeywords
      end sub
      
      
      
      $Ver = "Ver 0.50"
      
      %IDC_New                  = 102
      %IDC_Show                 = 103
      %IDC_Hlp                  = 108
      %IDC_Statusbar            = 110
      %IDC_Note                 = 201
      %IDC_DEBUG_LB             = 202
      %HASHTABLESIZE            = &H1000
      
      ' the following are used in DIALOG GET/SET USER statements
      ' user dialog user values for communicating with TACE
      %Ptr2UserText       = 1
      %Ptr2Keywords       = 2
      %CCERetval          = 3
      ' dialog user values used internally
      %Hashtab            = 4
      %FREPMSG            = 5
      '----------------------------------------------------------------------------
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' setRichTextColor sets the textcolor for selected text in a RichNote control.
      ' Example: CALL setRichTextColor(&HFF) sets the color to red.
      ' &HFF0000 is blue, &H008000 is dark green, &H0 is black, etc..
      ' ----------------------------------------------------------------------------
      function setRichTextColor( hNote as dword, byval NewColor as long) as long
        local cf as CHARFORMAT
      
        cf.cbSize      = len(cf)       'Length of structure
        cf.dwMask      = %CFM_COLOR    'Set mask to colors only
        cf.crTextColor = NewColor      'Set the new color value
        call SendMessage(hNote, %EM_SETCHARFORMAT, %SCF_SELECTION, varptr(cf))
      
      end function
      '-------------------------------------------------------------------------------
      ' a hashing algo
      function Elf32(sKey as string) as long
        local key as byte ptr
        local h as long
        local g as long
        local i as long
        key = strptr(sKey)
        h = 0
        while @key
          shift left h, 4
          h = h + @key
          key = key + 1
          g = h and &HF0000000???
          if g then
            i = g
            shift right i, 24
            h = h xor i
          end if
          h = h and (not g)
        wend
        function = h
      end function
      '-------------------------------------------------------------------------------
      sub getRichEditText(byval hEd as dword, byval psz as dword)
         local sBuffer as string, ES as EDITSTREAM
      
         es.dwCookie = psz
         es.pfnCallback = codeptr(getRichEditTextCB)
         SendMessage(hEd, %EM_STREAMOUT, %SF_TEXT, byval varptr(es))
      end sub
      '-------------------------------------------------------------------------------
      function getRichEditTextCB(byval dwCookie as dword, byval pRichEd as byte ptr, _
                               byval cb as long, byref pcb as long) as long
         local psBuffer as asciz ptr
         psBuffer = dwCookie
         if cb < 1 then exit function
         @psBuffer = @psBuffer & peek$(pRichEd, cb)
         pcb = cb
      end function
      '-------------------------------------------------------------------------------
      function putRichEditTextCB(byval dwCookie as dword, byval pRichEd as byte ptr, _
                            byval cb as long, byref pcb as long) as long
          'dwCookie used to pass ptr to asciz buffer holding the data to load
          'pRichEd is the ptr to the rich edit control buffer to receive the data
          'cb = bytes to read in chunks (4K) defined by the OS
          'pcb = bytes actually needed to be read (last chunk less than 4K)
          '-------------------------------------------------------------------------
          local psBuffer as asciz ptr
      
          psBuffer = dwCookie
          pcb = min(len(@psBuffer), cb)
          if pcb > 0 then
              poke$ pRichEd, left$(@psBuffer, pcb)
              @psBuffer = mid$(@psBuffer, pcb + 1)
          end if
      end function
      '-------------------------------------------------------------------------------
      function putRichEditText(byval hEd as dword, byval ps as string ptr) as long
      '   '-------------------------------------------------------------------------------
      '   'let rich edit call the callback function repeatedly, reading in 4K chunks
      '   'of data at a time until there is no more to read.
      '   '-------------------------------------------------------------------------------
         local ES as EDITSTREAM
         es.dwCookie    = ps
         es.pfnCallback = codeptr(putRichEditTextCB)
         function = SendMessage(hEd, %EM_STREAMIN, %SF_TEXT, byval varptr(es))  ' %SFF_TEXT
      end function
      '-------------------------------------------------------------------------------
      
      sub saveText( hNote as dword)
          SendMessage hNote, %EM_SETMODIFY, 0, 0
      end sub
      
      '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
      ' Syntax color parser for received line numbers
      ' borrowed from Borje Hagsten, much rewritten
      %our_quote = 1
      %our_comment = 2
      %our_word = 3
      %our_other = 4
      ' ----------------------------------------------------------------------------
      sub ScanLine(hNote as dword, byval Line1 as long, byval Line2 as long)
      
          local hUser as dword ' to hold the dialog handle of the user dialog which calls TACE
          local pd as CHARRANGE, Oldpd as CHARRANGE, tBuff as TEXTRANGE
          local szword as asciz * 256 ' to contain a word extracted from line
          local szBuf, sprotobuf as string ' line length propably won't exceed this!
          local openbrkt, Offset, levents, I, J, l, startpos, w as long
          local lnLen, Result, foundmatch, foundword as long
          local Letter as byte ptr
          local prevletter as byte
          local s, sword as string
          local phashtab              as long   ptr
          local pLangWords            as byte ptr
          local pKeyWords             as string ptr
          local sStringQuote, sSingleLineComment, SKeyWords                as string
          local n, ldebug, ldebugsave, lenszbuf    as long
          local tstart as double
          local CharVals()            as long
          dim charvals(0 to 255)
      
          tstart = timer ' debug
          '
          ' charvals : an array in which the index is the ASC value of a character,
          ' and the cell value is the sub index to execute when the char is encountered
          ' in the text being parsed for keywords.
          for n = 0 to 255: charvals(n) = %our_other:next
          '
      '    DIALOG GET USER hNote, %Ptr2Keywords TO pKeyWords
          ' first line is the word delimiters string
          s = parse$(gKeyWords, $crlf,1)
          ' these characters can terminate a "word" in the text being parsed:
          for n = 1 to len( s)
              charvals(asc(mid$(s,n,1))) = %our_word
          next
          ' next single line comment string, NB can be more than 1 char in length.
          ' if it is a single char, just enter it in the char table. If a string, make no
          ' entry in the char table... it is tested inline as a word.
          '
          sSingleLineComment = parse$(gKeyWords, $crlf,2)
          if len( sSingleLineComment) = 1 then charvals(asc(sSingleLineComment)) = %our_comment
          '
          ' next is the string quote char, always a single char
          sStringQuote = parse$(gKeyWords, $crlf,3)
          charvals(asc(sStringQuote)) = %our_quote
          ' rest is the keywords string as a single line
          sKeyWords = ucase$(parse$(gKeyWords, $crlf,4))
          pkeywords = varptr(sKeyWords)
          '
          dialog get user getparent(hNote), %HashTab to phashtab
          '
          call SendMessage(hNote, %EM_EXGETSEL, 0, varptr(Oldpd)) 'Original position
                                                                  '(so we can reset it later)
          'Disable the event mask, for better speed
          levents = SendMessage(hNote, %EM_GETEVENTMASK, 0, 0)
          call SendMessage(hNote, %EM_SETEVENTMASK, 0, 0)
      
          SendMessage hNote, %EM_HIDESELECTION,1,0
      
          if Line1 <> Line2 then                                  'if multiple lines
              mouseptr 11
          else                                                                     'editing a line
              pd.cpMin = SendMessage(hNote, %EM_LINEINDEX, Line1, 0)                'line start
              pd.cpMax = pd.cpMin + SendMessage(hNote, %EM_LINELENGTH, pd.cpMin, 0) 'line end
              call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))                  'select line
              setRichTextColor ( hNote, &H0)                                        'set black
          end if
          sprotobuf = string$(500," ")
      
          for J = Line1 to Line2
              szbuf = sprotobuf '+ " "
              Offset = SendMessage(hNote, %EM_LINEINDEX, J, 0)       'line start
              lnLen  = SendMessage(hNote, %EM_LINELENGTH, Offset, 0) 'line length
      
              if lnLen = 0 then iterate
              tBuff.chrg.cpMin = Offset
              ' the extra char is for CR or 1st char of next line if wrapped
              tBuff.chrg.cpMax = Offset + lnLen
              tBuff.lpstrText = strptr(szBuf)
              lnLen = SendMessage(hNote, %EM_GETTEXTRANGE, 0, byval varptr(tBuff)) 'Get line
              szbuf = left$(acode$(szbuf), lnLen)
              call CharUpperBuff(byval strptr(szBuf), lnLen)        'Make UCASE, handles all chars 0-255
              '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              ' Loop through the line, using a pointer for better speed
              '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              foundword = 0
              szbuf = szbuf + " " : incr lnLen ' force the last word in the line to be handled inside the loop
              Letter = strptr(szBuf)
              '
      
              for I = 1 to lnLen ' about 5% improvement
                  on Charvals(@letter) goto LQUOTE, LCOMMENT, LWORD, LOTHER
      LQUOTE:
                  startpos = instr(I + 1, szBuf, sStringQuote)
                  if startpos then
                      pd.cpMin = Offset + I
                      pd.cpMax = Offset + startpos - 1
                      call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))  ' was sendmessage
                      setRichTextColor hNote, &HFF
                      startpos = (startpos - I + 1)
                      I = I + startpos
                      Letter = Letter + startpos
                      foundword = 0
                  end if
                  incr letter
                  iterate
      LCOMMENT:
                  pd.cpMin = Offset + I - 1
                  pd.cpMax = Offset + lnLen
                  call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                  setRichTextColor hnote, &H00008000&
                  foundword = 0
                  exit for      ' done with line
      LWORD:
                  if foundword = 1 then
                      w = i - startpos
                      szword = mid$(szbuf, startpos, w + 1)
                      poke varptr(szword) + w , 0 ' null terminate!
                      if szword = sSingleLineComment then
                          pd.cpMin = Offset + I - w - 2
                          pd.cpMax = Offset + lnLen
                          call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                          setRichTextColor hnote, &H00008000&
                          foundword = 0
                          exit for
                      end if
      
                      n = elf32(trim$(szword)) mod %HASHTABLESIZE
      
                      foundmatch = %false
                      ldebug = 0
                      do while @phashtab[n] <> 0
                          incr ldebug
                          s = parse$(@pKeyWords, @phashtab[n])
                          if SZWORD <> parse$(@pKeyWords, @phashtab[n]) then
                              if n >= %HASHTABLESIZE then
                                  foundmatch = %false
                                  exit loop
                              else
                                  incr n
                              end if
                          else
                              foundmatch = %TRUE
                              exit loop
                          end if
                      loop
                      if ldebug > ldebugsave then ldebugsave = ldebug
                      if foundmatch = %FALSE then
                          incr letter
                          foundword = 0
                          iterate
                      end if
                      pd.cpMin = Offset + startpos - 1
                      pd.cpMax = Offset + I - 1
                      call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))       ' was sendmessage
                      call setRichTextColor( hnote, &HFF0000)                    'set blue color
                      foundword = 0
                  else
                      ' just in case the single line comment is two delimiters like // or --
                      if (@letter = prevletter ) and ((chr$(@letter) + chr$(@letter)) = sSingleLineComment) then
                          pd.cpMin = Offset + I - w - 2
                          pd.cpMax = Offset + lnLen
                          call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(pd))
                          setRichTextColor hnote, &H00008000&
                          foundword = 0
                          exit for
                      end if
                      prevLetter = @letter
                  end if
                  incr letter
                  iterate
      
      LOTHER:      ' we're inside a word
                  if foundword = 0 then
                      startpos = I
                  end if
                  foundword = 1
                  incr Letter
              next I
          next J
      
          'Reset original caret position
          call SendMessage(hNote, %EM_EXSETSEL, 0, byval varptr(Oldpd))
          SendMessage hNote, %EM_HIDESELECTION,0,0
      
          'Reset the event mask
          if levents then call SendMessage(hNote, %EM_SETEVENTMASK, 0, levents)
      end sub
      '------------------------------------------------------------------------------------
      function MakeFont(byval fName as string, byval ptSize as long, _
                        opt byval attr as string) as dword
         '--------------------------------------------------------------------
         ' Create a desired font and return its handle.
         ' attr = "biu" for bold, italic, and underlined (any order)
         '--------------------------------------------------------------------
         local hDC as dword, CharSet as long, CyPixels as long
         local bold, italic, uLine as long
         if len(attr) then
            if instr(lcase$(attr), "b") then bold = %FW_BOLD
            if instr(lcase$(attr), "i") then italic = 1
            if instr(lcase$(attr), "u") then uLine = 1
         end if
         hDC = GetDC(%hwnd_desktop)
         CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
         ReleaseDC %hwnd_desktop, hDC
         PtSize = 0 - (ptSize * CyPixels) \ 72
         function = CreateFont(ptSize, 0, 0, 0, bold, italic, uLine, _
                   %FALSE, CharSet, %OUT_TT_PRECIS, _
                   %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
                   %FF_DONTCARE , bycopy fName)
      end function
      '-------------------------------------------------------------------------------
      function quitNote( hD as dword, hNote as dword) as long
         local n as long
         function = -1
         if SendMessage(hNote, %EM_GETMODIFY, 0, 0) then ' file has changed
            n = msgbox("Text has changed..." & $crlf _
            & "do you want to save it?", %mb_taskmodal or %mb_yesnocancel or %mb_iconquestion, "Save Text")
            if n = %idcancel then
               function = 0
            else
               if n = %idyes then
                   ' export text
                   function = 1
               end if
            end if
         end if
      end function
      '------------------------------------------------------------------------
      function fileExists(fileName as string) as long
        local n as long
        n = getattr(fileName)
        function = (errclear = 0)
      end function
      '------------------------------------------------------------------------
      '<<<<<<<<<<<<<<<<<<<<<<<<<<<<< find & replace code borrowed from Eric Christensen
      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
      '-------------------------------------
      type FINDTEXTEXW
         chrg      as CHARRANGE    ' CHARRANGE chrg
         lpstrText as word ptr     ' LPCWSTR   lpstrText
         chrgText  as CHARRANGE    ' CHARRANGE chrgText
      end type
      '------------------------------------------------------------------
      type FINDTEXTEXW
         chrg      as CHARRANGE    ' CHARRANGE chrg
         lpstrText as word ptr     ' LPCWSTR   lpstrText
         chrgText  as CHARRANGE    ' CHARRANGE chrgText
      end type
      '------------------------------------------------------------------------------------------
      function dofindreplaceaction(byval llparam as long, byval hwnd 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 ptf as textrange ptr
          local buf as string
          local searchflag&, res&
          local n as long
          static s, stemp as string
          local tFT as FINDTEXTEXW
          local ps as asciz ptr
      
          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
          sendmessage hwnd, %em_exgetsel, 0, varptr(cr)
          '
          if (@lppfr.flags and %fr_findnext) then ' find next
              gosub positioncheck
              gosub search
              if isfalse match then ? "no match found",%mb_iconinformation or %mb_taskmodal, "find"
          elseif (@lppfr.flags and %fr_replace) then ' replace
              gosub search
              if istrue match then
                  sendmessage hwnd, %em_replacesel, %true, zt2
                  cr.cpmax = cr.cpmin + len(@zt2)
                  sendmessage hwnd, %em_exsetsel,0, varptr(cr)
                  gosub search
                  if isfalse match then msgbox "no further match found",%mb_taskmodal or %mb_iconinformation, "find"
              else
                  msgbox "no match found",%mb_taskmodal or %mb_iconinformation, "find"
              end if
          elseif (@lppfr.flags and %fr_replaceall) then ' replace all
              gosub search
              if istrue match then
                  do
                      sendmessage hwnd, %em_replacesel, %true, zt2
                      cr.cpmax = cr.cpmin + len(@zt2)
                      sendmessage hwnd, %em_exsetsel, 0,  varptr(cr)
                      gosub search
                  loop until isfalse match    ' loop until no more matches
              else
                  msgbox "no match found",%mb_taskmodal or %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)
              n = 999
              n = sendmessage (hwnd, %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
              tft.chrg.cpmin = cr.cpmin
              tft.chrg.cpmax = sendmessage ( hwnd, %em_getlimittext, 0, 0)
              s = ucode$(@zt)
              ps = strptr(s) 'movememory BYVAL ps, BYVAL STRPTR(s), BYVAL LEN(s) 'UCODE$(@zt),
              tft.lpstrtext  = ps
              '
              ' do specified search for specified text
              ipos = sendmessage (hwnd, %em_findtextexW, %FR_DOWN, varptr(tft)) ' searchflag&
      
              if ipos <> -1 then ' search is successful
                  cr.cpmin = ipos
                  cr.cpmax = cr.cpmin + len(@zt)
                  '
                  ' select found text
                  sendmessage hwnd, %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
      '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> /find & replace code borrowed from Eric Christensen
      '------------------------------------------------------------------------------
      callback function Floatmsg_dialogProc()
      
          select case as long cbmsg
              case %wm_initdialog
              case %wm_command
                  dialog end cbhndl, 0
              case %wm_destroy 'delete what we created on exit, to avoid mem leaks
          end select
      end function
      
      '------------------------------------------------------------------------------
      function FloatMsg_dialog(byval hParent as dword, s as string) as long
          local lRslt as long
          local hDlg  as dword
          local p as pointapi
          local x, y, w, h as long
      
          dialog get loc hparent to x, y
          dialog new pixels, hParent, "", x , y , 65, 14, %ws_popup or  _
              %ws_clipsiblings or %ws_visible  or _         ' OR  %DS_NOFAILCREATE OR %DS_3DLOOK OR %WS_THICKFRAME OR
              %ds_setfont, %ws_ex_controlparent or %ws_ex_toolwindow or _
              %ws_ex_topmost or %ws_ex_left or %ws_ex_ltrreading to hdlg
          dialog  set color   hDlg, -1, rgb(255, 255, 155)
          control add label, hDlg, 1001, s, 0, 0, 58, 12, %ss_notify
          control set color hdlg, 1001, -1, -2
          dialog show modeless hDlg, call FloatMsg_dialogProc to lRslt
          function = hdlg
      end function
      
      '----------------------------------------------------------------------------
      function subClassEditProc(byval hWnd as long, byval wMsg&, byval wParm&, byval lparam as long) as long
          local lRet                      as long
          local sztabchar                 as asciz * 2
          local szbuffer                  as asciz * %CCE_MAXTEXTSIZE
          local p                         as PointAPI
          local pdwretval                 as dword ptr
          static psUserTextBuffer         as string ptr
          local curline, l, MenuChoice    as long
          local s, smsg                   as string
          static flgs                     as long ' saving find or replace flags between calls.
          static lPrevSCLN, lSelChangeLineNum as long
          static hMsgFindReplace          as long
          static dwOrigEditProc, hw       as dword
          static InfoDlg                  as dword' handle of Ctrl-G info dialog
          static hpopup                   as dword ' menu handle
          '
          if hWnd& = 0 then           ' initial message from parent
              dwOrigEditProc = wparm&
              hMsgFindReplace = lparam
              function = 1
              exit function
          end if
      
          select case wMsg&
      
              case hMsgFindReplace ' this is the message registered
                  smsg = "FINDREPLACE"
                  ' do actions in response to your input in the dialog box
                  function = dofindreplaceaction(lparam, hWnd, flgs)
                  gosub tell
      
              case %wm_vscroll
      
              case %wm_user + 100             ' parent has recieved selchange notification
                  if InfoDlg <> 0 then
                      dialog end InfoDlg, 0
                      InfoDlg = 0
                  end if
      
                  gosub refreshKeyWords
      
              case %wm_keyup
                  l = wparm&
                  select case wParm&
                     case %VK_TAB
                        sztabchar = chr$(9): SendMessage hWnd, %EM_REPLACESEL, 1, byval varptr(sztabchar)
                  end select
      
              case %wm_rbuttonup
                  call GetCursorPos(byref p)
                  hPopup = CreatePopupMenu ' creating the menu inline to save having to pass the handle back
                                           ' to the main dlg which is where it would logically be destroyed.
                  call InsertMenu(hPopup, 0, %MF_BYCOMMAND              , 1, "&Find")
                  call InsertMenu(hPopup, 0, %MF_BYCOMMAND              , 2, "&Done")
                  MenuChoice = TrackPopupMenuEx(hPopup, %mf_enabled or %MF_BYCOMMAND or %TPM_RETURNCMD, p.x, p.y, _
                               getparent(hWnd), byval %NULL)
      
                  destroymenu ( hpopup)
                  control get user getparent(hwnd), %IDC_NOTE, %CCERetVal to pdwretval
                  select case menuchoice
                      case 1 ' find
                          call openfindorreplacetextdialog(hWnd, 1, flgs)
                      case 2 ' replace
                          call openfindorreplacetextdialog(hWnd, 2, flgs)
                      case 3 ' done
                          hw = getparent(hwnd)
                          getRichEditText( hWnd, byval varptr(szbuffer))
                          @pdwretval = 1
                          dialog end getparent(hWnd), 0
                      case 4 ' Cancel
                          @pdwretval = 0
                          dialog end getparent(hWnd), 0
                  end select
      
              case %wm_char
                   if InfoDlg <> 0 then
                       dialog end InfoDlg, 0
                       InfoDlg = 0
                   end if
                   select case wParm&
                       case &H16 ' have we been pasted with CTL-V ?
                           smsg = "CTRL-V"
                           scanline  hWnd, lPrevSCLN, lSelChangeLineNum
                  end select
      
              case %WM_GETDLGCODE
                  if isfalse lparam then 'not a message being sent to the control
                      ' Ensure that the edit control does not select its contents on receiving the focus
                      lRet = CallWindowProc(dwOrigEditProc, hWnd, wMsg&, wParm&, lparam)
                      function = lRet xor %dlgc_hassetsel 'Clear the DLGC_HASSETSEL bit from lRet
                      exit function
                  end if
      
          end select
          ' Pass the message on to the original window procedure
          function = CallWindowProc(dwOrigEditProc, hWnd, wMsg&, wParm&, lparam)
          exit function
      '
      refreshKeyWords:
          lPrevSCLN = lSelChangeLineNum
          lSelChangeLineNum = SendMessage(hWnd, %EM_EXLINEFROMCHAR, 0, -1)
      return
      '
      tell:
          return
      end function
      '----------------------------------------------------------------------------
      callback function showNoteProc()
          local fontSize, hpopup, i, l, linecount, menuchoice, wi, ht, tabunits as long
          local fontName, fn, s           as string
          static sbuffer                  as string
          static szbuffer                 as asciz * %CCE_MAXTEXTSIZE ' define the max buffer size for CCE
          local pmmi                      as MINMAXINFO ptr
          local p                         as PointAPI
          local pnmh                      as nmhdr ptr
          static flgs                     as long ' saving find or replace flags between calls.
          local CurLine                   as long  ' ephemeral current line position
          static hNote                    as dword
          local  pKeyWords                as string ptr     ' slangwords
          static lhashtab()               as long
          static lUboundCData             as long
          static szReqdchars              as asciz * 256
          static hMsgFindReplace          as long
          static dwOrigEditProc           as dword
          static  psUserTextBuffer        as asciz ptr
          local  dwInitProc               as long
          local pdw                       as dword ptr
          local huser                     as dword ' handle of user dialog which called TACE
          static hfont                    as dword ' font for editor window
          local h                         as dword
      
          select case cbmsg
            case %wm_initdialog
      
                redim lhashtab(0 to %HASHTABLESIZE -1) as static long ' %HASHTABLESIZE -1
                ' register a message for the find or replace dialog.
                hMsgFindReplace = registerwindowmessage ("commdlg_findreplace")
                dialog set user cbhndl, %Frepmsg, hMsgFindReplace
                gosub loaddata
                ' set pointer to KeyWords array as a property of this window
                dialog set user cbhndl, %Hashtab, varptr(lhashtab(0))
                '------------------------------------------------------------------
                ' resize dialog to show vertical scrollbar
                '------------------------------------------------------------------
                control handle cbhndl, %IDC_Note to hNote
                dialog get client cbhndl to wi, ht
                dialog set size cbhndl, wi, ht
      
                '------------------------------------------------------------------
                ' create and set an initial fixed-width font as default
                '------------------------------------------------------------------
                fontName = "Courier New": fontSize = 10
                hFont = MakeFont(fontName, fontSize)
                SendMessage hNote, %WM_SETFONT, hFont, 0
      
                tabUnits = 16 'interval of 8 spaces
                SendMessage hNote, %EM_SETTABSTOPS, 1, byval varptr(tabUnits)
                SendMessage hNote, %EM_LIMITTEXT, %CCE_MAXTEXTSIZE, 0
                SendMessage hNote, %EM_SETOPTIONS, %ECOOP_OR, %ECO_SELECTIONBAR 'left margin selection
                SendMessage hNote, %EM_FMTLINES, %TRUE, 0
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                'Must set the event mask, so we can pick up a few events from RichNote
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                call SendMessage(hNote, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE or %ENM_CHANGE or %ENM_UPDATE)
                dwOrigEditProc = SetWindowLong(hNote, %GWL_WNDPROC, codeptr(subClassEditProc)) 'subclass
                ' call the subclassed control directly
                ' to tell it what it's original WndProc is
                ' and what the find/replace message number is
                subClassEditProc ( 0, 0, dwOrigEditProc, hMsgFindReplace)
                SendMessage hNote, %EM_SETMODIFY, 0, 0
                h = cbhndl ' debug
                control get user cb.hndl, %IDC_Note, %Ptr2UserText to psUserTextBuffer
                szbuffer = space$(%CCE_MAXTEXTSIZE)
                szbuffer = @psUserTextBuffer
                putRichEditText( hNote, byval varptr(szbuffer)) 'hWnd, string ptr
                CurLine = SendMessage(hNote, %EM_getlinecount, 0, 0)
                call ScanLine(hnote, 0, CurLine)
      
              case %wm_size
                RedrawWindow cbhndl, byval 0, byval 0, %RDW_VALIDATE
                dialog get client cbhndl to wi, ht
                control set size cbhndl, %IDC_Note, wi, ht
                RedrawWindow cbhndl, byval 0, byval 0, %RDW_INVALIDATE
      
             case %WM_GETMINMAXINFO
                 pmmi = cblparam
                 @pmmi.ptMinTrackSize.x = 200  'minimum size of window
                 @pmmi.ptMinTrackSize.y = 200
      
             case %wm_command
                 select case cbctl
                     case %IDC_NOTE
                         select case hiwrd(cbwparam)   'show you where to find them
                             case %en_update 'is trigged before displaying altered text
                             case %en_change 'is trigged after..
                                 CurLine = SendMessage(hNote, %EM_EXLINEFROMCHAR, 0, -1)
                                 call ScanLine(hnote, CurLine, CurLine)
                         end select
                end select
      
             case %wm_notify
                 select case cbctl
                     case %IDC_NOTE
                         pnmh = cblparam
                         select case @pnmh.code
                             case %EN_SELCHANGE
                                 sendmessage hNote, %wm_user + 100, 0, 0
                         end select
                 end select
      
              case %WM_SETTEXT  ' assume that this is the initial data load of the edit control
                  control send cbhndl, %IDC_note, %WM_SETTEXT, cbwparam, cblparam
              '
              case %wm_user + 201  ' user shut down - drop everything & close
                  control kill cbhndl, %IDC_NOTE
                  dialog end cbhndl, 0
              '
              case %wm_user + 202  ' maximize window
                  dialog show state cbhndl,  %sw_show
              '
              case %wm_destroy
                  ' remove subclassing
                  SetWindowLong hNote, %GWL_WNDPROC, dwOrigEditProc
                  DeleteObject hFont
                  FreeLibrary ghLib
      
          end select
          exit function
          '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      loaddata:
          local hfile as long
          local n as long
      
          ' keywords string has 3 lines of non-keywords at start, strip these
          n = parsecount(gKeywords, $crlf)
          s = ucase$(parse$(gKeyWords,$crlf,4))
          '
          n = parsecount(s)
          for i = 0 to n -1
              h = elf32(parse$(s, i)) mod %HASHTABLESIZE
              while lhashtab(h)<> 0: incr h: wend
              lhashtab(h) = i
          next
      return
      end function
      '-------------------------------------------------------------------------------------------
      ' params are parent window coordinates for edit window, text ptr, title
      function CCE_BASRO ( hParent as dword, r as rect, byval pstext as dword, Title as string) as long
      
          local nStyle, bStyle as long
          local dwresult as dword ' to contain the result from the CB function
          local dwretval              as dword
          local hDlg as dword
          static s as string
      
          local debug1, debug2 as string ptr
      
          CreatePBKeyWordString ' create global keywords string
          ghLib = LoadLibrary("Msftedit.dll") 'Riched32.dll")
      '    hLib = LoadLibrary("Riched20.dll")
          if ghLib = 0 then
             s = "File 'Msftedit.dll' required"
             msgbox s, %mb_taskmodal or %mb_iconwarning, "File not Found": exit function
          end if
          ghLib = 0
          nStyle = %ws_child or %ws_popup or %ws_sysmenu or %ws_minimizebox or %ws_maximizebox or _
                   %ds_center or %ds_modalframe or %ws_thickframe or %ws_caption
      
          dialog new pixels, 0, Title, r.nleft, r.ntop, r.nright, r.nbottom, nStyle to hDlg
          '
          nStyle = %ws_child  or %ws_clipchildren or %ws_visible or %es_multiline _
                 or %ws_vscroll or %es_autovscroll  or %ws_hscroll  or %es_autohscroll or %es_wantreturn _
                 or %ws_tabstop  or %es_nohidesel    ' or %ES_NOIME
      
          control add "RichEdit50W", hDlg, %IDC_Note, "", 0, 0, r.nright, r.nbottom, nStyle
          control set user hdlg, %IDC_NOTE, %Ptr2UserText, pstext
      
          ' send our dialog & editor control hwnd to parent
          dialog send hparent, %wm_user + 500, hdlg, %IDC_NOTE
          ' set edit window to Read Only
          control send hDlg, %IDC_Note, %EM_SETREADONLY, 1, 0
          dialog show modeless hDlg, call ShowNoteProc to dwresult
          function = hDlg
      end function
      Last edited by Chris Holbrook; 15 Sep 2009, 01:24 AM.

      Comment


      • #4
        Cannot compile the applications

        Hi Chris

        1. Include files : Jose Roca
        2. Compiler : PBWin 9.05 for Windows

        When I try to compile the application it give me this error report for all your examples.

        PowerBASIC for Windows
        PB/Win Version 9.05.
        Copyright (c) 1996-2010 PowerBasic Inc.
        Englewood, Florida USA
        All Rights Reserved

        Error 481 in C:\PROGRAM FILES\POWERBASIC\FORUMS\POWERBASIC\SOURCE CODE\2009\PBWIN\SOURCE\CCE_BASRO_NEW.INC(452:006): Mismatch with prior definition
        Line 452: type FINDTEXTEXW


        What wrong here it's in de type struct
        Can you please help me

        Thanks
        Stephane

        Comment


        • #5
          Stephane, please don't post questions or responses in the Source Code forum. You will notice that almost all threads here have a "comments" or "discussion" link - post your question or response there instead. Also, look at the notice at the top of the forum. What does it say?

          Thanks for telling me about the problem. I will look into it.

          **** added - there wasn't a problem, see discussion thread.
          Last edited by Chris Holbrook; 7 Feb 2011, 01:31 PM.

          Comment


          • #6
            Faster

            The main code only has changed - the viewer source code can be taken from the post above.

            The time to load a source file is now greatly reduced.

            Comments here

            Code:
            ''
            ' A Blocklist (Function/sub/method/class/type) utility inspired by PowerBASIC's F2 function
            ' Presents a list of blocks from which a selection can be made to view source code
            ' Synchronises with the last saved version of the subject file by checking the directory entry
            ' every 2000 milliseconds or so and reloading the function index and any changed windows
            '
            ' Chris Holbrook 12-Sep-2009
            '
            ' Changes
            ' 13-SEP-2009 includes comments preceding sub/function header in the function viewer windows
            ' 13-SEP-2009 uses keyword, comment and literal coloring
            ' 14-SEP-2009 added tooltips to controls on main screen
            ' 14-SEP-2009 added source file name to main dialog title
            ' 15-SEP-2009 fixed GPF problem
            ' 15-SEP-2009 only a single source code file can be examined by a single instance of the application
            '
            ' Issues list (* = incorporated in change)
            ' 13-SEP-2009 PB keyword list is for PBWin V7 only
            ' 14-SEP-2009 refreshes all viewer windows when any change occurs, not just the changed ones.
            ' 14-SEP-2009 * Charles Dietz & Artur Gomide report GPFs - cannot recreate
            '
            ' to do list (* = incorporated in change)
            ' 15-SEP-2009 Gösta H. Lovgren-2 suggests making the function list sortable
            ' 15-SEP-2009 Gösta H. Lovgren-2 suggests including macros
            ' 15-SEP-2009 * Gösta H. Lovgren-2 suggests making the initial screen larger
            ' 15-SEP-2009 Add a viewer window containing all globals
            ' 15-SEP-2009 Add a viewer window containing all variable declarations
            ' 15-SEP-2009 Add a viewer window containing all TYPE declarations
            ' 15-SEP-2009 Add a viewer window containing the code before the first function/macro declaration
            '
            ' 7-FEB-2011 improved the performance of the source file load
            '19-FEB-2011 fixed bug where CLASS and CLASS METHOD were handled wrongly
            '19-FEB-2011 Added multi-line MACRO sensing
            '19-FEB-2011 Added TYPE declaration sensing
            '19-FEB-2011 fixed bug where leading comments were not properly handled
            '19-FEB-2011 fixed bug where trailing lines were included after END...
            '19-FEB-2011 Path of target source code file can be supplied on command line as first parameter
            #compile exe
            #debug display
            #dim all
            
            #include "WIN32API.INC"
            #include "COMMCTRL.INC"
            #include "COMDLG32.INC"
            #include "richedit.inc"
            #include "c:\chris\edit\CCE_BASRO.INC"  '<==========you will need to change this!
            $version = "0.1.4"
            %TIMERINTERVAL   = 2000
            %IDD_DIALOG1         =  101
            %IDC_LV = 1001
            %IDD_DIALOG2         =  102
            %IDC_TEXTBOX1        = 1003
            %IDC_SOUFILE_BN      = 1004
            
            type tfindex
                sfname as asciz * 256
                start as long
                finish as long
                hwnd as dword
                ptr2source as asciz ptr
            end type
            global findex() as tfindex      ' global table of functions and subs
            global sourcecode as string   ' global table of source code
            global ghfont as dword          ' font
            'global gOutputHandle as dword
            '-----------------------------------------------------------------------------
            global hWndToolTip  as dword
            '-----------------------------------------------------------------
            sub CreateTip( hDlg as dword, tl as dword, Tip as string )
            static Crt          as CREATESTRUCT
            static TlInfo       as TOOLINFO
            static hInst        as long
            
                if hWndToolTip then 'it's been initialized
            
                    if tl = 0 then exit if
                    'Tip = Left$(Tip, 79)
                    control handle hDlg, tl to tl
                    TlInfo.hwnd = tl
                    TlInfo.uId = tl
                    TlInfo.lpszText = strptr(Tip)
                    SendMessage( hWndToolTip, %TTM_ADDTOOL, 0, varptr( TlInfo ) )
                    SendMessage( hWndToolTip, %TTM_ACTIVATE, 1, 0 )
            
                else 'just initializing this time through
                    local ice as INIT_COMMON_CONTROLSEX
                    ice.dwSize = sizeof(ice)
                    ice.dwICC = %ICC_WIN95_CLASSES
                    InitCommonControlsEx(ice)
            
                    hInst = GetModuleHandle("")
                    Tip = "ToolTip"
                    Crt.lpCreateParams = 0
                    Crt.hInstance    = hInst
                    Crt.hMenu        = 0
                    Crt.hwndParent   = hDlg
                    Crt.style        = %ws_popup or %TTS_NOPREFIX or %TTS_ALWAYSTIP
                    Crt.lpszName     = strptr(Tip)
                    Tip = $TOOLTIPS_CLASS
                    Crt.lpszClass    = strptr(Tip)
                    Crt.dwExStyle    = %ws_ex_topmost
            
                    hWndToolTip = CreateWindowEx( %ws_ex_topmost, $TOOLTIPS_CLASS, "", _
                    %ws_popup or %TTS_NOPREFIX or %TTS_ALWAYSTIP or %TTS_BALLOON, _
                        %CW_USEDEFAULT, %CW_USEDEFAULT, %CW_USEDEFAULT, _
                        %CW_USEDEFAULT, hDlg, 0, hInst, Crt )
            
            
                    dialog send hWndToolTip, %TTM_SETMAXTIPWIDTH, 0, 200
            
                    SetWindowPos( hWndToolTip, %HWND_TOPMOST, 100, 100, 300, 300, _
                        %SWP_NOMOVE or %SWP_NOSIZE or %SWP_NOACTIVATE )
            
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_INITIAL, 100 ) 'time a pointer must remain stationary before the tooltip appears
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 7000 ) 'time a tooltip window remains visible If the Pointer is stationary
                    SendMessage( hWndToolTip, %TTM_SETDELAYTIME, %TTDT_RESHOW, 400 ) 'time before subsequent tooltips to appear
            
                    '------------------------------
                    TlInfo.cbSize = sizeof( TOOLINFO )
                    'this doesn't make sense, but it works
                    TlInfo.uFlags = %TTF_SUBCLASS or %TTS_ALWAYSTIP or %TTS_BALLOON or %TTF_CENTERTIP
                    'if hToolParWnd <> 0 then tl is a control ID instead of a window handle
                    TlInfo.hinst = hInst
            
                end if 'hWndToolTip
            
            end sub 'CreateTip
            
            '-------------------------------------------------------------------------------------------------------------
            sub SetToolTips(hDlg as dword)
            static  f   as long
            
                if f then exit sub else incr f 'make sure it only runs once
                    CreateTip hDlg, 0, ""     'initialize tooltips
                    CreateTip hDlg, %IDC_LV, "Click a function in the listview to see the source code in a new window"
                    CreateTip hDlg, %IDC_SOUFILE_BN, "Click here to chose a new source file"
            end sub 'SetToolTips
            
            '---------------------------------------------------------------------------
            function build ( hD as dword, LVid as long, sfile as string) as long
                local i, j, n, hfile, nrow, linenum as long
                local s, sline, s1, s2, s3, slist, swork as string
                local nsource as long
                local p as asciz ptr
                local t as quad
                local lline, lcomments as long
                local lpline, pcomments as asciz ptr
            
                hfile = freefile
                try
                    open sfile for binary as hfile
                    nsource = lof(hfile)
                    get$ #hfile, nsource, sourcecode
                    close hfile
                catch
                    dialog set text hd, "FILE ERROR": beep: sleep 2000
                    exit function
                end try
                ' pick out functions & subs from the array
                ' i is the offset of the start of line character in sourcecode
                ' lline is the line number
                ' row is the listview row number
                ' lcomments is the line # of the start of comments block prior to the proc
                ' pcomments is a ptr to the start of the comments block
                i = 1 ' character position
                while i =< nsource
                    j = i
                    sline = mid$(sourcecode, i, 255)
                    replace $crlf with $nul in sline
                    p = strptr(sline)
                    SWORK = @p + " @@@@@@@@"
                    s1 = ucase$(parse$(ltrim$(swork), " ", 1))
                    s2 = parse$(ltrim$(swork), any " (", 2)
                    s3 = parse$(ltrim$(swork), any " (", 3)
                    if left$(s1,1) = "'" then s1 = "REM"
                    select case s1
                        case "REM" ' start comment block
                            if lcomments = 0 then
                                lcomments = lline
                                pcomments = strptr(sourcecode) + i - 1
                            end if
                        '
                        case "SUB"
                            gosub addtolist
                        '
                        case "TYPE"
                            gosub addtolist
                        '
                        case "FUNCTION"
                            if left$(s2,1) <> "=" then gosub addtolist
                        '
                        case "METHOD"
                            if left$(s2,1) <> "=" then gosub addtolist
                        '
                        case "MACRO"
                            if left$(s2,1) <> "=" then gosub addtolist
                        '
                        case "CLASS" ' either a CLASS declaration or a CLASS METHOD declaration
                            gosub addtolist
                        '
                        case "CALLBACK"
                            gosub addtolist
                        '
                        case "END"
                            if ucase$(left$(s2,8)) = "FUNCTION" then
                                gosub nudgelist
                                exit select
                            end if
                            if ucase$(left$(s2,5)) = "CLASS" then
                                gosub nudgelist
                                exit select
                            end if
                            if ucase$(left$(s2,6)) = "METHOD" then
                                gosub nudgelist
                                exit select
                            end if
                            if ucase$(left$(s2,5)) = "MACRO" then
                                gosub nudgelist
                                exit select
                            end if
                            '
                            if ucase$(left$(s2,3)) = "SUB" then
                                gosub nudgelist
                            end if
                            '
                            if ucase$(left$(s2,4)) = "TYPE" then
                                gosub nudgelist
                            end if
                        '
                        case else ' unstart comment block
                            lcomments = 0
            
                    end select
                    i += len(@p) + 2 ' advance i to next line start
                    incr lline          ' increment line count
                wend
                s = ""
                findex(nrow).finish  = lline
                exit function
            '''''''''''''''
            addtolist:
                incr nrow
                select case as const$ S1
                    case "CALLBACK"
                        s = s3
                    '
                    case "CLASS"
                        s = s2
                        if ucase$(S2) = "METHOD" then
                            s = s3
                        end if
                    '
                    case else
                        s = s2
                end select
                listview insert item hD, %IDC_LV, nrow, 0, s
                redim preserve findex(1 to nrow)
                if lcomments then
                    findex(nrow).ptr2source = pcomments
                    findex(nrow).start  = lcomments
                    if nrow > 1 then
                        findex(nrow-1).finish = lcomments - 1
                    end if
                else
                    findex(nrow).ptr2source = strptr(sourcecode) + i - 1
                    findex(nrow).start  = lline
                end if
                lcomments = 0 ' unstart comment block
                findex(nrow).sfname = s'sourcecode(i)
                listview set text hD, %IDC_LV, nrow, 2, ltrim$(sline) 'sourcecode(i)
            return
            '''''''''''''''
            nudgelist:
                findex(nrow).finish = lline 'i
                lcomments = 0 ' unstart comment block
            return
            end function
            '--------------------------------------------------------
            callback function MainDlgProc()
                local sfname as string ' filename of source code file
                local i, j, l, n, nfrom, nto, nsel, x, y as long
                local s, ss, st, soldcode, spath as string
                ' temporary array into which the old findex array is copied
                ' when a dirent change is detected
                local prevfindex() as tfindex
                ' rect used to define CCE window
                local r as rect
                local p as asciz ptr
            
                ' used in checking the dirent for updates
                static htimer as dword
                ' filename and dialog title
                static sourcecodefile, stitle as string
                ' used in checking the dirent for updates
                static dird, dird1 as dirdata
                '
                select case as long cbmsg
                    case %wm_initdialog
                        'startconsole
                        settooltips ( cb.hndl)
                        listview set stylexx cb.hndl, %IDC_LV, _
                            %lvs_ex_infotip or %lvs_ex_fullrowselect or  %lvs_ex_oneclickactivate or %lvs_ex_gridlines
                        listview  insert column cb.hndl, %IDC_LV, 1, "Name", 100, 0
                        listview  insert column cb.hndl, %IDC_LV, 2, "header", 500, 0
                        stitle = "F2+ Source Code File Selection"
                        if trim$(command$) <> "" then
                            sourcecodefile = command$(1)
                            gosub gotsourcecodefile
                        end if
                    '
                    case %wm_destroy
                        killtimer cb.hndl, htimer
                        if ubound(findex()) < 0 then exit select
                        for i = lbound(findex()) to ubound(findex())
                            if findex(i).hWnd <> 0 then
                                dialog end findex(i).hWnd, 0
                            end if
                        next
                    '
                    case %wm_ncactivate
                        static hWndSaveFocus as dword
                        if isfalse cbwparam then
                            hWndSaveFocus = GetFocus()
                        elseif hWndSaveFocus then
                            SetFocus(hWndSaveFocus)
                            hWndSaveFocus = 0
                        end if
                    '
                    case %wm_timer
                        if trim$(sourcecodefile) = "" then
                            exit select
                        end if
                        s = dir$ (sourcecodefile to dird1)
                        if dird1.LastWriteTime <> dird.lastwritetime then
                            dird = dird1
                            listview reset cb.hndl, %IDC_LV
                            l = lbound(findex())
                            dim prevfindex(l to ubound(findex()))
                            poke$ varptr(prevfindex(l)), peek$(varptr(findex(l)),sizeof(findex(l)) * arrayattr(findex(),4))
                            erase findex()
                            
                            build(cb.hndl, %IDC_LV, sourcecodefile)
                            for i = lbound(findex()) to ubound(findex())
                                 if prevfindex(i).hWnd then
                                     ' get the text in the "new" file for the named Function
                                     ' kill off viewer window
                                     dialog end prevfindex(i).hWnd, 0
                                     s = trim$(prevfindex(i).sfname)
                                     listview find exact cb.hndl, %IDC_LV, 1, s to n
                                     ' if the function no longer exists, no further action required
                                     if n = 0 then exit select
                                     ' fn is present, create a new window
                                     s = ""
                                     p = findex(i).ptr2source
                                     for j = findex(i).start to findex(i).finish
                                         ss = left$(@p,255)
                                         replace $crlf with $nul in ss
                                         p += len(@p) + 1' jump over null
                                         s = s + $crlf + ss
                                     next
                                     s = mid$(s, 3) ' lose leading $crlf
                                     stitle = findex(i).sfname + " in " + sourcecodefile + " " + time$
                                     setrect r, 0, 0, 400, 300
                                     findex(i).hWnd = CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                                 end if
                            next
                        end if
                    '
                    case %wm_user + 501 ' child dialog has ended - clear hWnd in findex table
                        for i = lbound(findex()) to ubound(findex())
                            if findex(i).hWnd = cb.wparam then
                                findex(i).hWnd = 0
                                exit for
                            end if
                        next
                    '
                    case %wm_move, %wm_size
                        local xx, yy as long
                        if cb.wparam = %SIZE_MINIMIZED then
                            for i = lbound(findex()) to ubound(findex())
                                if findex(i).hWnd <> 0 then
                                    dialog send findex(i).hWnd, %wm_syscommand, %sc_minimize, 0
                                end if
                            next
                        end if
                        dialog get client cb.hndl to x, y
                        control set size cb.hndl, %IDC_LV, x, y -25
                        control get size cb.hndl, %IDC_SOUFILE_BN to xx, yy
                        control set size cb.hndl, %IDC_SOUFILE_BN, x, yy
                    '
                    case %wm_notify
                        select case cb.ctl
                            case %IDC_LV
                                select case cb.nmcode
                                    case %nm_click
                                        listview get select cb.hndl, %IDC_LV to nsel
                                        if nsel > ubound(findex()) then
                                            ? "selected item above expected range"
                                            exit select
                                        end if
                                        if nsel < lbound(findex()) then
                                            ? "selected item below expected range"
                                            exit select
                                        end if
            
                                        nfrom = findex(nsel).start
                                        nto   = findex(nsel).finish
                                        p = findex(nsel).ptr2source
                                        for j = findex(nsel).start to findex(nsel).finish
                                             ss = left$(@p, instr(@p,$crlf))
                                             p += len(ss)
                                             incr p' jump over LF
                                             s += ss
                                        next
                                        stitle = findex(nsel).sfname + " in " + sourcecodefile + " " + time$
                                        setrect r, 0, 0, 400, 300
                                        findex(nsel).hWnd = CCE_basro( cb.hndl, r, byval strptr(s), stitle)
                                end select
                        end select
                    '
                    case %wm_command
            
                        select case cb.ctl
                            case %IDC_SOUFILE_BN
                                gosub setsourcecodefile
                        end select
                    '
            '        case %wm_ncactivate
            '            static hWndSaveFocus as dword
            '            if isfalse cbwparam then
            '                hWndSaveFocus = GetFocus()
            '            elseif hWndSaveFocus then
            '                SetFocus(hWndSaveFocus)
            '                hWndSaveFocus = 0
            '            end if
                end select
                exit function
            ''''''''''''''''''''''
            setsourcecodefile:
                spath = curdir$
                OpenFileDialog(cb.hndl, stitle, sourcecodefile, sPATH, _
                    "Basic Source Code Files|*.bas|Include Files|*.inc|All Files|*.*", "txt", 0)
            gotsourcecodefile:
                if trim$(sourcecodefile) = "" then return
                control set text cb.hndl, %IDC_SOUFILE_BN, sourcecodefile
                sfname = parse$(sourcecodefile,"\",-1)
                dialog set text cb.hndl, "F2+ " + $version + " " + sfname
                if ubound(findex) > -1 then
                    for i = lbound(findex()) to ubound(findex())
                        if findex(i).hWnd then dialog end findex(i).hWnd, 0
                    next
                end if
                erase findex()
                s = dir$ (sourcecodefile to dird)
                listview reset cb.hndl, %IDC_LV
                build(cb.hndl, %IDC_LV, sourcecodefile)
                htimer = settimer ( cb.hndl,%null, %TIMERINTERVAL, %null)
            return
            end function
            '------------------------------------------------------------------------
            function MainDlg(byval hParent as dword) as long
                local lRslt, w, h as long
                local hDlg  as dword
            
                dialog font default "Courier New", 10, 0, 0
                dialog new hParent, "F2+", 0, 0, 201, 321, _
                    %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or %ws_minimizebox or _
                    %ws_clipchildren or %ws_visible or %ds_modalframe or %ds_3dlook or _
                    %ds_nofailcreate or %ds_setfont or %ds_center or %ws_thickframe, _
                    %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _
                    to hDlg
                dialog get client hDlg to w, h
                control add button, hDlg, %IDC_SOUFILE_BN, "source code file", 0, 0, w, 14
                control add listview, hDlg, %IDC_LV, "", 0, 15, 192, 100, _
                    %ws_child or %ws_visible or %ws_tabstop or %lvs_report or %lvs_showselalways, _
                    %ws_ex_left or %ws_ex_clientedge or %ws_ex_rightscrollbar
                dialog show modal hDlg, call MainDlgProc to lRslt
                function = lRslt
            end function
            '---------------------------------------------------------------------
            ' testing comment block prior to a proc
            function pbmain()
                initcommoncontrols
                MainDlg %hwnd_desktop
            end function
            Last edited by Chris Holbrook; 19 Feb 2011, 10:20 AM. Reason: updated - see comments thread

            Comment

            Working...
            X