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

Virtual multicolumn listbox to simulate a listview like "grid control"

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

  • Virtual multicolumn listbox to simulate a listview like "grid control"

    ' this program presents a virtual multicolumn listbox to simulate
    ' a listview like "grid control". the virtual multicolumn listbox can
    ' present two dimensional string arrays of any size. only the part of the
    ' data being displayed at any one time are being used by the listbox.
    '
    ' the program applies scroll bar controls and subclassing for processing of
    ' key messages.
    '
    ' you can edit any cell if you so wishes. any other operation you may want
    ' to include (e.g. sorting) should be done directly on the data array.
    ' the listbox is only used to display the data.

    ' due to the automatic "internal" movements of list boxes, the code for movement
    ' by using the arrow keys is quite complex and possibly rather obscure. it
    ' could no doubt be improved in certain aspects.
    '
    ' the code skeleton was generated by ezgui freeware dialog designer
    ' by christopher r. boss see web site at ezgui.com.
    ' unused code has been removed to improve clarity.
    '
    ' p.s. october, 16th 2001:
    ' the program has been improved thanks to received feedback. now you can
    ' also activate editing of the current cell by pressing enter. you can
    ' still double click the cell for the same purpose. furthermore, you can
    ' also use enter and esc to terminate editing of a cell in addition to using the buttons.
    '
    ' semen matusovski, borje hagsten, adrian aitken and lance edmonds are
    ' thanked for their inspirational influence on the code.
    '
    ' best wishes
    '
    ' erik christensen, copenhagen, denmark ---- e.chr@email.dk

    ' further comments should go to this address:
    http://www.powerbasic.com/support/pb...ead.php?t=4340
    Code:
    #compile exe
    #register none
    #dim all
    %noanimate    = 1
    %nocombo      = 1
    %nodraglist   = 1
    %noheader     = 1
    %noimagelist  = 1
    %nolistview   = 1
    %nostatusbar  = 1
    %notabcontrol = 1
    %notoolbar    = 1
    %notooltips   = 1
    %notreeview   = 1
    %noupdown     = 1
    #include "win32api.inc"
    #include "commctrl.inc"
    '
    %gridlistbox        = 100
    %colheaderlist      = 105
    %rowheaderlist      = 110
    %exitbutton         = 115
    %rowident           = 120
    %vertscrollbar      = 135
    %horzscrollbar      = 140
    %editdescript       = 145
    '
    %editlabel          = 400
    %edittext           = 410
    %editok             = 415
    %editcancel         = 420
    ' --------------------------------------------------
    declare sub showlistdialog(byval hparent&)
    declare callback function listdialogproc
    declare callback function editdialogproc
    declare sub editcellform(byval hparent&)
    declare callback function cbf_gridlistbox()
    declare callback function cbf_colheaderbox()
    declare callback function cbf_rowheaderbox()
    declare callback function cbf_rowident()
    declare callback function cbf_exit()
    declare callback function cbf_edittext()
    declare callback function cbf_editok()
    declare callback function cbf_editcancel()
    declare sub updatewindowandscrollbars (byval xpos as long,byval ypos as long)
    ' --------------------------------------------------
    global brush&
    global hlistform&           ' dialog handle
    global heditform&           ' dialog handle
    
    global rows as long         ' total number of rows in array
    global columns as long      ' total number of columns in array
    
    global pagerows as long     ' number of rows on a page
    global pagecolumns as long  ' number of columns on a page
    
    global dataarray() as string' two dimensional text array to be displayed
    global colhead() as string  ' column header array
    global rowhead() as string  ' row header array
    
    global six as scrollinfo
    global siy as scrollinfo
    global prevkey as long      ' previously pressed key
    global goldsubclasslist&
    global goldsubclassedit&
    global prescurspos as long  ' present cursor position in grid list box
    global curscorr as long     ' correction used to place cursor correctly
    global selx as long         ' column selected
    global sely as long         ' row selected
    global xcr!,ycr!            ' conversion factors from pixels to dialog units
    global xmaxscr as long
    global ymaxscr as long
    
    ' --------------------------------------------------
    '
    function pbmain
        local hdc as long
        local count&
        local cc1 as init_common_controlsex
        cc1.dwsize=sizeof(cc1)
        cc1.dwicc=%icc_win95_classes
        initcommoncontrolsex cc1
        brush&=createsolidbrush(rgb(196,196,196))  ' light grey
        showlistdialog 0
        do
            dialog doevents to count&
        loop until count&=0
        deleteobject brush&
    end function
    
    ' --------------------------------------------------
    '
    function xdu(xpct as single) as long  ' x transformation function just for this program
        xdu=xpct*800*0.01/xcr!
    end function
    
    function ydu(ypct as single) as long  ' y transformation function just for this program
        ydu=ypct*543*0.01/1.90
    end function
    
    sub showlistdialog(byval hparent&)
        local style&, exstyle&,hctl&,i&,j&
        local x&,y&,x1&,y1&,hdlg&,res&
    
        xmaxscr=getsystemmetrics(%sm_cxfullscreen)
        if xmaxscr >800 then xmaxscr=800
        ymaxscr=getsystemmetrics(%sm_cyfullscreen)
        if ymaxscr >543 then ymaxscr=543
        x&=300: y&=200
        dialog new 0,",,,x&,y&, %ws_visible, to hdlg&
        dialog units hdlg&, x&, y& to pixels x1&, y1&
        dialog end hdlg&
        xcr!=x1&*10000/x&: xcr!=xcr!/10000
        ycr!=y1&*10000/y&: ycr!=ycr!/10000
        '
        ' specification of size of array.
        ' you may test other sizes.
        rows=100
        columns=500
        '
        ' grid routines are made for arrays no less than (4,20)
        columns=max(4,columns)
        rows=max(20,rows)
        ' fill array with data
        redim dataarray(1:columns,1:rows)
        redim colhead(1:columns)
        redim rowhead(1:rows)
        for i&=1 to columns
            colhead(i&)=" column"+str$(i&)
            for j&=1 to rows
                if i&=1 then rowhead(j&)=" row"+str$(j&)
                dataarray(i&,j&)=" column"+str$(i&)+" row"+str$(j&)
            next
        next
        style& = %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center
        exstyle& = 0
        dialog new hparent&, "multicolumn list box for grid data", 0, 0,xdu(98),ydu(92), style&, exstyle& to hlistform&
        control add listbox, hlistform&,%gridlistbox, , xdu(18.5),ydu(6.65),xdu(71.5),ydu(59.41), _
           %ws_child or %ws_visible or %lbs_notify or %lbs_multicolumn or %ws_border or %ws_tabstop call cbf_gridlistbox
        control send hlistform&,%gridlistbox,%lb_setcolumnwidth,xdu(17.8)*xcr!,0
        control add scrollbar, hlistform&,%horzscrollbar," ,xdu(18.5),ydu(63),xdu(71.5),ydu(3.7), _
            %ws_child or %ws_visible or %sbs_horz
        control add scrollbar, hlistform&,%vertscrollbar," , xdu(90),ydu(6.65),xdu(2.5),ydu(56.4), _
            %ws_child or %ws_visible or %sbs_vert
        control add listbox, hlistform&,  %colheaderlist, ,xdu(18.5),ydu(2.96),xdu(71.5),ydu(3.7), _
            %ws_child or %ws_visible or %lbs_notify or %lbs_multicolumn or %lbs_nointegralheight or %ws_border or %ws_tabstop call cbf_colheaderbox
        control send hlistform&,%colheaderlist,%lb_setcolumnwidth,xdu(17.8)*xcr!,0
        control add listbox, hlistform&,  %rowheaderlist, ,xdu(1.5),ydu(6.65),xdu(17),ydu(59.4), _
            %ws_child or %ws_visible or %lbs_notify or %lbs_multicolumn or %ws_border or %ws_tabstop call cbf_rowheaderbox
        control add button, hlistform&,  %exitbutton,  "e&xit",xdu(80),ydu(72),xdu(10),ydu(4.43), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_exit
        control add listbox, hlistform&,  %rowident, , xdu(1.5),ydu(2.96),xdu(17),ydu(3.7), _
            %ws_child or %ws_visible or %lbs_notify or %lbs_nointegralheight or %ws_border or %ws_tabstop call cbf_rowident
        listbox add hlistform&,%rowident,"row identification"
        control add label, hlistform&, %editdescript,"press enter or double-click to edit cell", xdu(32),ydu(72),xdu(35),ydu(4.43), _
            %ws_child or %ws_visible or %ss_center
        dialog show modeless hlistform& , call listdialogproc
    end sub
    ' --------------------------------------------------
    '
    callback function listdialogproc
        local hctl&, result&,i&,j&,n&
        local cursel&
        select case cbmsg
            case %wm_initdialog
                control handle cbhndl, %gridlistbox to hctl&
                goldsubclasslist& = setwindowlong(hctl&, %gwl_wndproc, codeptr(subclasslistkeys))
                '
                ' number of rows and columns in a displayed page
                pagerows=20
                pagecolumns = 4
                '
                ' the scrollbar control bits are based on a fine example
                ' by lance edmonds in the source code forum.
                '
                ' define vertical scrollbar
                siy.cbsize = sizeof(siy)
                siy.fmask  = %sif_all   ' = %sif_range or %sif_page or %sif_pos
                siy.nmin   = 1
                siy.nmax   = rows
                siy.npage  = pagerows
                siy.npos   = 1
                control send cbhndl, %vertscrollbar, %sbm_setscrollinfo, %false, varptr(siy)
                '
                ' define horizontal scrollbar
                six.cbsize = sizeof(six)
                six.fmask  = %sif_all   ' = %sif_range or %sif_page or %sif_pos
                six.nmin   = 1
                six.nmax   = columns
                six.npage  = pagecolumns
                six.npos   = 1
                control send cbhndl,%horzscrollbar, %sbm_setscrollinfo, %false, varptr(six)
                '
                ' fill window with data
                call updatewindowandscrollbars (six.npos,siy.npos)
            case %wm_vscroll
                select case lowrd(cbwparam)
                    case %sb_linedown      : incr siy.npos
                    case %sb_pagedown      : siy.npos = siy.npos + siy.npage - 1
                    case %sb_lineup        : decr siy.npos
                    case %sb_pageup        : siy.npos = siy.npos - siy.npage + 1
                    case %sb_thumbtrack,%sb_thumbposition
                        ' this code allows for tracking above the 16-bit limit (65536) of hiwrd
                        ' proposed by borje hagsten
                        siy.cbsize = sizeof(siy)
                        siy.fmask  = %sif_trackpos
                        control send cbhndl, %vertscrollbar, %sbm_getscrollinfo,0, varptr(siy)
                        siy.npos   = siy.ntrackpos
                    case else              : exit function
                end select
                ' ensure that position is within range
                siy.npos = max&(siy.nmin, min&(siy.npos, siy.nmax - siy.npage + 1))
                prevkey = 0
                call updatewindowandscrollbars (six.npos,siy.npos)
            case %wm_hscroll
                select case lowrd(cbwparam)
                    case %sb_lineright     : incr six.npos
                    case %sb_pageright     : six.npos = six.npos + six.npage - 1
                    case %sb_lineleft      : decr six.npos
                    case %sb_pageleft      : six.npos = six.npos - six.npage + 1
                    case %sb_thumbtrack,%sb_thumbposition
                        ' this code allows for tracking above the 16-bit limit (65536) of hiwrd
                        ' proposed by borje hagsten
                        six.cbsize = sizeof(six)
                        six.fmask  = %sif_trackpos
                        control send cbhndl, %horzscrollbar, %sbm_getscrollinfo,0, varptr(six)
                        six.npos   = six.ntrackpos
                    case else              : exit function
                end select
                ' ensure that position is within range
                six.npos = max&(six.nmin, min&(six.npos, six.nmax - six.npage + 1))
                prevkey = 0
                call updatewindowandscrollbars (six.npos,siy.npos)
            case %wm_destroy
                ' important! remove the subclassing
                setwindowlong hctl&, %gwl_wndproc, goldsubclasslist&
            ' -----------------------------------------------
            case %wm_ctlcolormsgbox , %wm_ctlcolorbtn, %wm_ctlcoloredit,_
                 %wm_ctlcolorstatic, %wm_ctlcolorscrollbar, %wm_ctlcolorlistbox
                ' control colors
                select case getdlgctrlid(cblparam)
                    case %colheaderlist
                        settextcolor cbwparam, rgb(0,0,0)       ' black
                        setbkcolor   cbwparam, rgb(196,196,196) ' light grey
                        function=brush&
                    case %rowheaderlist
                        settextcolor cbwparam, rgb(0,0,0)
                        setbkcolor   cbwparam, rgb(196,196,196)
                        function=brush&
                    case %rowident
                        settextcolor cbwparam, rgb(0,0,0)
                        setbkcolor   cbwparam, rgb(196,196,196)
                        function=brush&
                    case else
                        function=0
                end select
            case else
        end select
        ' enable redrawing of grid window
        control send hlistform&,%gridlistbox,%wm_setredraw,%true,0 to result&
    end function
    ' --------------------------------------------------
    callback function subclasslistkeys
        ' subclass callback function for processing key messages.
        ' inspired by lance edmonds who provided a fine example in the source code forum
        ' completed after valuable feedback by semen matusovski and borje hagsten.
        local result&
        select case cbmsg
            ' the %wm_getdlgcode message is sent to the dialog box procedure
            ' associated with a control. normally, windows handles all arrow-key
            ' and tab-key input to the control.
            ' by responding to the %wm_getdlgcode message, an application can
            ' take control of a particular type of input and process the input itself.
            case %wm_getdlgcode
                ' specifies that the only extra key we want to be available is
                ' the enter key (= %vk_return) (chr$(13)).
                ' this particular expression was proposed by borje hagsten
                if cbwparam = %vk_return then
                    function = %dlgc_wantallkeys : exit function
                end if
            case %wm_keydown ' keys at time of pressing
                ' the statements below for up, down, left and right move are adjusted for
                ' the "internal" automatic movement produced by the listbox.
                select case cbwparam
                    case %vk_up
                        if prevkey=%vk_up then
                            if prescurspos mod pagerows <= 1 then decr siy.npos  : curscorr=1
                        elseif prevkey<>%vk_down then
                            if prescurspos mod pagerows = 0 then decr siy.npos  : curscorr=1
                        end if
                    case %vk_down
                        if prevkey=%vk_down then
                            if prescurspos mod pagerows >= pagerows - 2 then incr siy.npos : curscorr=-1
                        elseif prevkey<>%vk_up then
                            if prescurspos mod pagerows = pagerows - 1 then incr siy.npos : curscorr=-1
                        end if
                    case %vk_left
                        if prevkey=%vk_left then
                            if prescurspos <pagerows*2 then decr six.npos
                        elseif prevkey<>%vk_right then
                            if prescurspos <pagerows*1 then decr six.npos
                        end if
                    case %vk_right
                        if prevkey=%vk_right then
                            if prescurspos >=pagerows*(pagecolumns-2) then incr six.npos : curscorr=-pagerows
                        elseif prevkey<>%vk_left then
                            if prescurspos >=pagerows*(pagecolumns-1) then incr six.npos : curscorr=-pagerows
                        end if
                    ' the selection movements for pgup and pgdn are the "internal" automatic listbox movements.
                    ' i have not been able to adjust them satisfactorily. you may have an idea.
                    case %vk_pgup  :   siy.npos = siy.npos - siy.npage + 1
                    case %vk_pgdn  :   siy.npos = siy.npos + siy.npage - 1
                    '
                    case %vk_home  :   six.npos = 0: siy.npos = 0
                    case %vk_end   :   six.npos = columns: siy.npos = rows
                    case else
                end select
                prevkey = cbwparam
                ' ensure that positions are within range
                six.npos = max&(six.nmin, min&(six.npos, six.nmax - six.npage + 1))
                siy.npos = max&(siy.nmin, min&(siy.npos, siy.nmax - siy.npage + 1))
                call updatewindowandscrollbars (six.npos,siy.npos)
            case %wm_keyup ' keys at time of release (not used)
            case %wm_char  ' any character key at time of pressing
                select case cbwparam ' holds the code of the key.
                    ' specify what action should be taken for each key code.
                    case 13 ' enter pressed
                        ' ensure that a cell is selected before editing.
                        ' otherwise you will have a fatal error !
                        control send hlistform&,%gridlistbox,%lb_getcaretindex,0,0 to result&
                        control send hlistform&,%gridlistbox,%lb_setcursel, result&,-1
                        call prepareforedit
                        exit function
                    case else ' no action to be taken here for the other keys.
                end select
        end select
        ' pass the message on to the original window procedure... the ddt engine!
        function = callwindowproc(goldsubclasslist, cbhndl, cbmsg, cbwparam, cblparam)
    end function
    ' --------------------------------------------------
    sub updatewindowandscrollbars (byval xpos as long,byval ypos as long)
        ' updates the listbox data to be presented after scrolling.
        local i&,j&,res&
        static yprevpos as long  ' previous y-position (remember between calls)
        static xprevpos as long  ' previous x-position (remember between calls)
        control send hlistform&,%gridlistbox,%lb_getcursel,0,0 to prescurspos
        if xpos<>xprevpos or ypos<>yprevpos then ' moved
            control send hlistform&,%gridlistbox,%wm_setredraw,%false,0 to res&
            if xpos<>xprevpos then ' moved in x-direction (horizontal)
                ' update horizontal scroll bar
                six.fmask = %sif_pos
                control send hlistform&, %horzscrollbar, %sbm_setscrollinfo, %true, varptr(six)
                ' update column header
                control send hlistform&,%colheaderlist,%lb_resetcontent,0,0
                for i&=xpos to xpos + pagecolumns - 1
                    listbox add hlistform&,%colheaderlist,colhead(i&)
                next
            end if
            if ypos<>yprevpos then ' moved in y-direction (vertical)
                ' update vertical scroll bar
                siy.fmask = %sif_pos
                control send hlistform&, %vertscrollbar, %sbm_setscrollinfo, %true, varptr(siy)
                ' update row header
                control send hlistform&,%rowheaderlist,%lb_resetcontent,0,0
                for j&=ypos to ypos + pagerows - 1
                    listbox add hlistform&,%rowheaderlist,rowhead(j&)
                next
            end if
            ' update window data
            control send hlistform&,%gridlistbox,%lb_resetcontent,0,0
            for i&=xpos to xpos + pagecolumns - 1
                for j&=ypos to ypos + pagerows - 1
                    listbox add hlistform&,%gridlistbox,dataarray(i&,j&)
                next
            next
        end if
        control send hlistform&,%gridlistbox,%lb_setcursel,prescurspos+curscorr,0
        if prevkey = 0 then ' deselect cursor at list position zero
            control send hlistform&,%gridlistbox,%lb_setcursel,0,0
            control send hlistform&,%gridlistbox,%lb_setcursel,-1,0
        end if
        curscorr = 0 ' reset correction of selection position
        ' new "previous" positions to be remembered for the next update call
        yprevpos=ypos: xprevpos=xpos
    end sub
    ' ------------------------------------------------
    callback function cbf_gridlistbox
        if cbctlmsg=%lbn_dblclk then call prepareforedit
    end function
    ' ------------------------------------------------
    sub prepareforedit
        local buffer as asciiz * 256
        local cval&
        ' return current selection in cval&
        control send hlistform&,%gridlistbox, %lb_getcursel, 0,0 to cval&
        ' get array index corresponding to selected cell
        selx = six.npos+int(cval&/pagerows)
        sely = siy.npos+cval& mod pagerows
        call editcellform(hlistform&) ' edit cell - new text to data array
        buffer = dataarray(selx,sely) ' new text from data array to buffer
        ' update listbox with new text
        control send hlistform&,%gridlistbox,%lb_deletestring,cval&,0
        control send hlistform&,%gridlistbox,%lb_insertstring,cval&,varptr(buffer)
        control send hlistform&,%gridlistbox,%lb_setcursel, cval&,-1
    end sub
    ' ------------------------------------------------
    callback function cbf_rowheaderbox
        control set focus hlistform&, %gridlistbox
    end function
    ' ------------------------------------------------
    callback function cbf_colheaderbox
        control set focus hlistform&, %gridlistbox
    end function
    ' ------------------------------------------------
    callback function cbf_rowident
        control set focus hlistform&, %gridlistbox
    end function
    ' ------------------------------------------------
    callback function cbf_exit
        local res&
        res&=msgbox ("are you sure?",%mb_yesno or %mb_iconquestion ,"exit program?")
        if res&=%idyes then dialog end hlistform&
    end function
    '
    ' ------------------------------------------------
    ' code section for editing of cell text
    ' ------------------------------------------------
    '
    sub editcellform(byval hlistform&) ' make and display edit form
        local style&, exstyle&
        style& = %ws_popup or %ds_modalframe or %ws_caption or %ds_center
        exstyle& = 0
        dialog new hlistform&, "edit cell", 0, 0,  200,  48, style&, exstyle& to heditform&
        control add label, heditform&,  %editlabel,  "column"+str$(selx)+"  row"+str$(sely), 6, 2, 188, 10, _
            %ws_child or %ws_visible or %ss_center
        control add textbox, heditform&,  %edittext,  dataarray(selx,sely), 6, 12, 188, 12, _
            %ws_child or %ws_visible or %es_autohscroll or %ws_tabstop, %ws_ex_clientedge
        ' the following two statements deselect the text and place caret at the end of the text.
        control send heditform&, %edittext,%em_setsel,0,-1  ' select all text
        control send heditform&, %edittext,%em_setsel,-1,-1 ' deselect text
        control add button, heditform&,  %editok,  "&ok", 154, 30, 40, 12, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_editok
        control add button, heditform&,  %editcancel,  "&cancel", 104, 30, 40, 12, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_editcancel
        dialog show modal heditform&, call editdialogproc
    end sub
    ' ------------------------------------------------
    callback function editdialogproc
        local hctl&,j&,result&
        select case cbmsg
            case %wm_initdialog
                control handle cbhndl, %edittext to hctl&
                goldsubclassedit& = setwindowlong(hctl&, %gwl_wndproc, codeptr(subclasseditkeys))
            case %wm_destroy
                ' important! remove the subclassing
                setwindowlong hctl&, %gwl_wndproc, goldsubclassedit&
            case else
        end select
    end function
    ' ------------------------------------------------
    callback function subclasseditkeys
        ' subclass callback function for processing key messages in edit control (textbox).
        ' completed after valuable feedback by semen matusovski and borje hagsten.
        local result&
        '
        select case cbmsg
            '
            ' the %wm_getdlgcode message is sent to the dialog box procedure
            ' associated with a control. normally, windows handles all arrow-key
            ' and tab-key input to the control.
            ' by responding to the %wm_getdlgcode message, an application can
            ' take control of a particular type of input and process the input itself.
            case %wm_getdlgcode
                ' specifies that we want all keys entered in the textbox to be
                ' available here.
                function = %dlgc_wantallkeys: exit function
            case %wm_keydown ' keys at time of pressing (not used here)
            case %wm_keyup   ' keys at time of release (not used here)
            case %wm_char    ' any character key at time of pressing
                select case cbwparam ' holds the code of the key.
                    ' specify what action should be taken for each key code.
                    case 13 ' enter pressed
                        control get text heditform&,%edittext to dataarray(selx,sely)
                        control send hlistform&,%gridlistbox,%lb_setcursel,-1,0 ' deselect cell
                        dialog end heditform&
                        exit function
                    case 27 ' escape pressed
                        dialog end heditform&
                        exit function
                    case else ' no action to be taken here for the other keys.
                end select
        end select
        ' pass the message on to the original window procedure... the ddt engine!
        function = callwindowproc(goldsubclassedit&, cbhndl, cbmsg, cbwparam, cblparam)
    end function
    ' ------------------------------------------------
    callback function cbf_editok
        ' update data array with edited text
        control get text heditform&,%edittext to dataarray(selx,sely)
        dialog end heditform&
    end function
    ' ------------------------------------------------
    callback function cbf_editcancel
        dialog end heditform&
    end function



    [this message has been edited by erik christensen (edited october 16, 2001).]

  • #2
    ' October 17th version of the the "hidden listbox" approach.
    '
    ' Virtual multicolumn listbox with hidden listbox receiving keyboard input.
    '
    ' In this 2nd version the automatic "internal" movements of the displayed
    ' listbox is completely avoided by placing the focus on a hidden listbox
    ' which through the subclassing will be performing the "internal" movements
    ' produced by the keyboard input. This means even better performance of the
    ' displayed listbox.
    '
    ' However, due to the focus being on the hidden listbox, any selected cell
    ' will be "de-selected" immediately when moving occurs. This may be
    ' considered a drawback of this hidden listbox approach.
    '
    ' The code skeleton was generated by EZGUI Freeware Dialog Designer
    ' by Christopher R. Boss see web site at EZGUI.COM.
    ' Unused code has been removed to improve clarity.
    '
    ' The program has been improved thanks to received feedback.
    ' You can now use ENTER and ESC to terminate editing of a cell in addition
    ' to using the buttons.
    '
    ' Semen Matusovski, Borje Hagsten, Adrian Aitken and Lance Edmonds are
    ' thanked for their inspirational influence on the code.
    '
    ' Best wishes
    '
    ' Erik Christensen, Copenhagen, Denmark ---- e.chr@email.dk
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    %NOANIMATE    = 1
    %NOCOMBO      = 1
    %NODRAGLIST   = 1
    %NOHEADER     = 1
    %NOIMAGELIST  = 1
    %NOLISTVIEW   = 1
    %NOSTATUSBAR  = 1
    %NOTABCONTROL = 1
    %NOTOOLBAR    = 1
    %NOTOOLTIPS   = 1
    %NOTREEVIEW   = 1
    %NOUPDOWN     = 1
    #INCLUDE "win32api.inc"
    #INCLUDE "commctrl.inc"
    '
    %GridListBox        = 100
    %ColHeaderList      = 105
    %RowHeaderList      = 110
    %ExitButton         = 115
    %RowIdent           = 120
    %VertScrollbar      = 135
    %HorzScrollbar      = 140
    %EditDescript       = 145
    '
    %HiddenListbox      = 150
    '
    %EditLabel          = 400
    %EditText           = 410
    %EditOK             = 415
    %EditCancel         = 420
    ' --------------------------------------------------
    DECLARE SUB ShowListDialog(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION ListDialogProc
    DECLARE CALLBACK FUNCTION EditDialogProc
    DECLARE SUB EditCellForm(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION CBF_GridListBox()
    DECLARE CALLBACK FUNCTION CBF_ColHeaderBox()
    DECLARE CALLBACK FUNCTION CBF_RowHeaderBox()
    DECLARE CALLBACK FUNCTION CBF_RowIdent()
    DECLARE CALLBACK FUNCTION CBF_Exit()
    DECLARE CALLBACK FUNCTION CBF_EditText()
    DECLARE CALLBACK FUNCTION CBF_EditOK()
    DECLARE CALLBACK FUNCTION CBF_EditCancel()
    DECLARE SUB UpdateWindowAndScrollbars (BYVAL xPos AS LONG,BYVAL yPos AS LONG)
    ' --------------------------------------------------
    GLOBAL Brush&
    GLOBAL hListForm&           ' Dialog handle
    GLOBAL hEditForm&           ' Dialog handle
    
    GLOBAL Rows AS LONG         ' Total number of rows in array
    GLOBAL Columns AS LONG      ' Total number of columns in array
    
    GLOBAL PageRows AS LONG     ' Number of rows on a page
    GLOBAL PageColumns AS LONG  ' Number of columns on a page
    
    GLOBAL DataArray() AS STRING' Two dimensional text array to be displayed
    GLOBAL ColHead() AS STRING  ' Column header array
    GLOBAL RowHead() AS STRING  ' Row header array
    
    GLOBAL siX AS SCROLLINFO
    GLOBAL siY AS SCROLLINFO
    GLOBAL PrevKey AS LONG      ' Previously pressed key
    GLOBAL gOldSubClassList&
    GLOBAL gOldSubClassEdit&
    GLOBAL SelX AS LONG         ' Column selected
    GLOBAL SelY AS LONG         ' Row selected
    GLOBAL XCR!,YCR!            ' conversion factors from pixels to dialog units
    GLOBAL XMaxScr AS LONG
    GLOBAL YMaxScr AS LONG
    
    ' --------------------------------------------------
    '
    FUNCTION PBMAIN
        LOCAL hDC AS LONG
        LOCAL Count&
        LOCAL CC1 AS INIT_COMMON_CONTROLSEX
        CC1.dwSize=SIZEOF(CC1)
        CC1.dwICC=%ICC_WIN95_CLASSES
        InitCommonControlsEX CC1
        Brush&=CreateSolidBrush(RGB(196,196,196))  ' light grey
        ShowListDialog 0
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
        DeleteObject Brush&
    END FUNCTION
    
    ' --------------------------------------------------
    '
    FUNCTION XDU(XPct AS SINGLE) AS LONG  ' X transformation function just for this program
        XDU=XPct*800*0.01/XCR!
    END FUNCTION
    '
    FUNCTION YDU(YPct AS SINGLE) AS LONG  ' Y transformation function just for this program
        YDU=YPct*543*0.01/1.90
    END FUNCTION
    '
    SUB ShowListDialog(BYVAL hParent&)
        LOCAL Style&, ExStyle&,hCtl&,i&,j&
        LOCAL X&,Y&,X1&,Y1&,hDlg&,res&
    
        XMaxScr=GetSystemMetrics(%SM_CXFULLSCREEN)
        IF XMaxScr >800 THEN XMaxScr=800
        YMaxScr=GetSystemMetrics(%SM_CYFULLSCREEN)
        IF YMaxScr >543 THEN YMaxScr=543
        X&=300: Y&=200
        DIALOG NEW 0,"",,,X&,Y&, %WS_VISIBLE, TO hDlg&
        DIALOG UNITS hDlg&, X&, Y& TO PIXELS X1&, Y1&
        DIALOG END hDlg&
        XCR!=X1&*10000/X&: XCR!=XCR!/10000
        YCR!=Y1&*10000/Y&: YCR!=YCR!/10000
        '
        ' Specification of size of array.
        ' You may test other sizes.
        Rows=100
        Columns=500
        '
        ' Grid routines are made for arrays no less than (4,20)
        Columns=MAX(4,Columns)
        Rows=MAX(20,Rows)
        ' Fill array with data
        REDIM DataArray(1:Columns,1:Rows)
        REDIM ColHead(1:Columns)
        REDIM RowHead(1:Rows)
        FOR i&=1 TO Columns
            ColHead(i&)=" column"+STR$(i&)
            FOR j&=1 TO Rows
                IF i&=1 THEN RowHead(j&)=" row"+STR$(j&)
                DataArray(i&,j&)=" column"+STR$(i&)+" row"+STR$(j&)
            NEXT
        NEXT
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hParent&, "Multicolumn List Box For Grid Data", 0, 0,XDU(98),YDU(92), Style&, ExStyle& TO hListForm&
        CONTROL ADD LISTBOX, hListForm&,%GridListBox, , XDU(18.5),YDU(6.65),XDU(71.5),YDU(59.41), _
           %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTICOLUMN OR %WS_BORDER OR %WS_TABSTOP CALL CBF_GridListBox
        CONTROL SEND hListForm&,%GridListBox,%LB_SETCOLUMNWIDTH,XDU(17.8)*XCR!,0
        '
        ' Make a small (and therefore automatically hidden) listbox to receive keyboard input when having the focus.
        ' Since this listbox needs to be active, you should not hide it by using any specific command to that effect.
        ' If you make its height small as here, it will be hidden automatically.
        CONTROL ADD LISTBOX, hListForm&, %HiddenListbox,, XDU(1),YDU(85),XDU(15),YDU(1), _
            %WS_CHILD OR %LBS_NOTIFY
        CONTROL ADD SCROLLBAR, hListForm&,%HorzScrollbar,"" ,XDU(18.5),YDU(63),XDU(71.5),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
        CONTROL ADD SCROLLBAR, hListForm&,%VertScrollbar,"" , XDU(90),YDU(6.65),XDU(2.5),YDU(56.4), _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        CONTROL ADD LISTBOX, hListForm&,  %ColHeaderList, ,XDU(18.5),YDU(2.96),XDU(71.5),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTICOLUMN OR %LBS_NOINTEGRALHEIGHT OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ColHeaderBox
        CONTROL SEND hListForm&,%ColHeaderList,%LB_SETCOLUMNWIDTH,XDU(17.8)*XCR!,0
        CONTROL ADD LISTBOX, hListForm&,  %RowHeaderList, ,XDU(1.5),YDU(6.65),XDU(17),YDU(59.4), _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTICOLUMN OR %WS_BORDER OR %WS_TABSTOP CALL CBF_RowHeaderBox
        CONTROL ADD BUTTON, hListForm&,  %ExitButton,  "E&xit",XDU(80),YDU(72),XDU(10),YDU(4.43), _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Exit
        CONTROL ADD LISTBOX, hListForm&,  %RowIdent, , XDU(1.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT OR %WS_BORDER OR %WS_TABSTOP CALL CBF_RowIdent
        LISTBOX ADD hListForm&,%RowIdent,"Row Identification"
        CONTROL ADD LABEL, hListForm&, %EditDescript,"Double-click to edit cell", XDU(35),YDU(72),XDU(35),YDU(4.43), _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        ' Set focus to hidden list (away from the shown listbox). Thus the
        ' automatic internal movements will just affect that hidden list. The
        ' movements specified in the program can then affect the shown listbox without
        ' being hampered by any "internal" automatic keyboard movements in this
        ' control.
        CONTROL SET FOCUS hListForm&, %HiddenListbox
        DIALOG SHOW MODELESS hListForm& , CALL ListDialogProc
    END SUB
    ' --------------------------------------------------
    '
    CALLBACK FUNCTION ListDialogProc
        LOCAL hCtl&, Result&,i&,j&,N&
        LOCAL CurSel&
        SELECT CASE CBMSG
            CASE %WM_INITDIALOG
                ' Make subclassing to the hidden list (away from the shown listbox
                ' control). When having the focus this hidden list will receive
                ' the keyboard input. Thus the automatic internal movements will
                ' then take place in that hidden list (not in the shown listbox).
                CONTROL HANDLE CBHNDL, %HiddenListbox TO hCtl&
                gOldSubClassList = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassListKeys))
                '
                ' Number of rows and columns in a displayed page
                PageRows=20
                PageColumns = 4
                '
                ' The scrollbar control bits are based on a fine example
                ' by Lance Edmonds in the source code forum.
                '
                ' Define vertical scrollbar
                siY.cbSize = SIZEOF(siY)
                siY.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                siY.nMin   = 1
                siY.nMax   = Rows
                siY.nPage  = PageRows
                siY.nPos   = 1
                CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
                '
                ' Define horizontal scrollbar
                siX.cbSize = SIZEOF(siX)
                siX.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                siX.nMin   = 1
                siX.nMax   = Columns
                siX.nPage  = PageColumns
                siX.nPos   = 1
                CONTROL SEND CBHNDL,%HorzScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siX)
                '
                ' Fill window with data
                CALL UpdateWindowAndScrollbars (siX.nPos,siY.nPos)
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINEDOWN      : INCR siY.nPos
                    CASE %SB_PAGEDOWN      : siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %SB_LINEUP        : DECR siY.nPos
                    CASE %SB_PAGEUP        : siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %SB_THUMBTRACK,%SB_THUMBPOSITION
                        ' This code allows for tracking above the 16-bit limit (65536) of HIWRD
                        ' Proposed by Borje Hagsten
                        siY.cbSize = SIZEOF(siY)
                        siY.fMask  = %SIF_TRACKPOS
                        CONTROL SEND CBHNDL, %VertScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siY)
                        siY.nPos   = siY.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                ' Ensure that position is within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                PrevKey = 0
                CALL UpdateWindowAndScrollbars (siX.nPos,siY.nPos)
            CASE %WM_HSCROLL
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINERIGHT     : INCR siX.nPos
                    CASE %SB_PAGERIGHT     : siX.nPos = siX.nPos + siX.nPage - 1
                    CASE %SB_LINELEFT      : DECR siX.nPos
                    CASE %SB_PAGELEFT      : siX.nPos = siX.nPos - siX.nPage + 1
                    CASE %SB_THUMBTRACK,%SB_THUMBPOSITION
                        ' This code allows for tracking above the 16-bit limit (65536) of HIWRD
                        ' Proposed by Borje Hagsten
                        siX.cbSize = SIZEOF(siX)
                        siX.fMask  = %SIF_TRACKPOS
                        CONTROL SEND CBHNDL, %HorzScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siX)
                        siX.nPos   = siX.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                ' Ensure that position is within range
                siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                PrevKey = 0
                CALL UpdateWindowAndScrollbars (siX.nPos,siY.nPos)
            CASE %WM_DESTROY
                ' Important! Remove the subclassing
                SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassList&
            ' -----------------------------------------------
            CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE %ColHeaderList
                        SetTextColor CBWPARAM, RGB(0,0,0)       ' black
                        SetBkColor   CBWPARAM, RGB(196,196,196) ' light grey
                        FUNCTION=Brush&
                    CASE %RowHeaderList
                        SetTextColor CBWPARAM, RGB(0,0,0)
                        SetBkColor   CBWPARAM, RGB(196,196,196)
                        FUNCTION=Brush&
                    CASE %RowIdent
                        SetTextColor CBWPARAM, RGB(0,0,0)
                        SetBkColor   CBWPARAM, RGB(196,196,196)
                        FUNCTION=Brush&
                    CASE ELSE
                        FUNCTION=0
                END SELECT
            CASE ELSE
        END SELECT
        ' Enable redrawing of grid window
        CONTROL SEND hListForm&,%GridListBox,%WM_SETREDRAW,%TRUE,0 TO Result&
    END FUNCTION
    ' --------------------------------------------------
    CALLBACK FUNCTION SubClassListKeys
        ' Subclass callback function for processing key messages.
        ' Inspired by Lance Edmonds who provided a fine example in the Source Code Forum
        LOCAL Result&
        SELECT CASE CBMSG
            CASE %WM_KEYDOWN ' Keys at time of pressing
                ' The statements below for UP, DOWN, LEFT and RIGHT move are adjusted for
                ' the "internal" automatic movement produced by the listbox.
                SELECT CASE CBWPARAM
                    CASE %VK_UP    :   DECR siY.nPos
                    CASE %VK_DOWN  :   INCR siY.nPos
                    CASE %VK_LEFT  :   DECR siX.nPos
                    CASE %VK_RIGHT :   INCR siX.nPos
                    CASE %VK_PGUP  :   siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %VK_PGDN  :   siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %VK_HOME  :   siX.nPos = 0: siY.nPos = 0
                    CASE %VK_END   :   siX.nPos = Columns: siY.nPos = Rows
                    CASE ELSE
                END SELECT
                PrevKey = CBWPARAM
                ' Ensure that positions are within range
                siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbars (siX.nPos,siY.nPos)
            CASE %WM_KEYUP ' Keys at time of release (not used)
            CASE %WM_CHAR  ' Any character key at time of pressing (not used)
        END SELECT
        ' Pass the message on to the original window procedure... the DDT engine!
        FUNCTION = CallWindowProc(gOldSubClassList, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    ' --------------------------------------------------
    SUB UpdateWindowAndScrollbars (BYVAL xPos AS LONG,BYVAL yPos AS LONG)
        ' Updates the listbox data to be presented after scrolling.
        LOCAL i&,j&,Res&
        STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
        STATIC xPrevPos AS LONG  ' previous x-position (remember between calls)
        IF xPos<>xPrevPos OR yPos<>yPrevPos THEN ' Moved
            CONTROL SEND hListForm&,%GridListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
            IF xPos<>xPrevPos THEN ' Moved in X-direction (horizontal)
                ' Update horizontal scroll bar
                siX.fMask = %SIF_POS
                CONTROL SEND hListForm&, %HorzScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siX)
                ' Update column header
                CONTROL SEND hListForm&,%ColHeaderList,%LB_RESETCONTENT,0,0
                FOR i&=xPos TO xPos + PageColumns - 1
                    LISTBOX ADD hListForm&,%ColHeaderList,ColHead(i&)
                NEXT
            END IF
            IF yPos<>yPrevPos THEN ' Moved in Y-direction (vertical)
                ' Update vertical scroll bar
                siY.fMask = %SIF_POS
                CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
                ' Update row header
                CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
                FOR j&=yPos TO yPos + PageRows - 1
                    LISTBOX ADD hListForm&,%RowHeaderList,RowHead(j&)
                NEXT
            END IF
            ' Update window data
            CONTROL SEND hListForm&,%GridListBox,%LB_RESETCONTENT,0,0
            FOR i&=xPos TO xPos + PageColumns - 1
                FOR j&=yPos TO yPos + PageRows - 1
                    LISTBOX ADD hListForm&,%GridListBox,DataArray(i&,j&)
                NEXT
            NEXT
        END IF
        ' New "previous" positions to be remembered for the next update call
        yPrevPos=yPos: xPrevPos=xPos
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_GridListBox
        LOCAL buffer AS ASCIIZ * 256
        LOCAL CVal&
        IF CBCTLMSG=%LBN_SELCHANGE THEN
            ' set focus to the hidden listbox
            CONTROL SET FOCUS hListForm&, %HiddenListbox
        END IF
        IF CBCTLMSG=%LBN_DBLCLK THEN ' prepare for editing of selected cell
            ' Return Current Selection in CVal&
            CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
            ' Get array index corresponding to selected cell
            SelX = siX.nPos+INT(CVal&/PageRows)
            SelY = siY.nPos+CVal& MOD PageRows
            CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
            buffer = DataArray(SelX,SelY) ' new text from data array to buffer
            ' Update ListBox with new text
            CONTROL SEND CBHNDL , CBCTL,%LB_DELETESTRING,CVal&,0
            CONTROL SEND CBHNDL , CBCTL,%LB_INSERTSTRING,CVal&,VARPTR(buffer)
            ' If you want to show the edited cell to be shown selected immediately
            ' after editing, you should uncomment the following statement.
            'CONTROL SEND CBHNDL , CBCTL,%LB_SETCURSEL, CVal&,-1
            ' set focus to the hidden listbox
            CONTROL SET FOCUS hListForm&, %HiddenListbox
        END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_RowHeaderBox
            CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_ColHeaderBox
            CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_RowIdent
            CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Exit
        LOCAL res&
        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Exit Program?")
        CONTROL SET FOCUS hListForm&, %HiddenListbox
        IF res&=%IDYES THEN DIALOG END hListForm&
    END FUNCTION
    '
    ' ------------------------------------------------
    ' Code section for editing of cell text
    ' ------------------------------------------------
    '
    SUB EditCellForm(BYVAL hListForm&) ' make and display edit form
        LOCAL Style&, ExStyle&
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hListForm&, "Edit cell", 0, 0,  200,  48, Style&, ExStyle& TO hEditForm&
        CONTROL ADD LABEL, hEditForm&,  %EditLabel,  "Column"+STR$(SelX)+"  Row"+STR$(SelY), 6, 2, 188, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD TEXTBOX, hEditForm&,  %EditText,  DataArray(SelX,SelY), 6, 12, 188, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
        ' The following two statements deselect the text and place caret at the end of the text.
        CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
        CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,-1,-1 ' deselect text
        CONTROL ADD BUTTON, hEditForm&,  %EditOK,  "&OK", 154, 30, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditOK
        CONTROL ADD BUTTON, hEditForm&,  %EditCancel,  "&Cancel", 104, 30, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditCancel
        DIALOG SHOW MODAL hEditForm&, CALL EditDialogProc
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION EditDialogProc
        LOCAL hCtl&,j&,Result&
        SELECT CASE CBMSG
            CASE %WM_INITDIALOG
                CONTROL HANDLE CBHNDL, %EditText TO hCtl&
                gOldSubClassEdit& = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassEditKeys))
            CASE %WM_DESTROY
                ' Important! Remove the subclassing
                SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassEdit&
            CASE ELSE
        END SELECT
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION SubClassEditKeys
        ' Subclass callback function for processing key messages in edit control (textbox).
        ' Completed after valuable feedback by Semen Matusovski and Borje Hagsten.
        LOCAL Result&
        '
        SELECT CASE CBMSG
            '
            ' The %WM_GETDLGCODE message is sent to the dialog box procedure
            ' associated with a control. Normally, Windows handles all arrow-key
            ' and TAB-key input to the control.
            ' By responding to the %WM_GETDLGCODE message, an application can
            ' take control of a particular type of input and process the input itself.
            CASE %WM_GETDLGCODE
                ' Specifies that we want all keys entered in the textbox to be
                ' available here.
                FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
            CASE %WM_KEYDOWN ' Keys at time of pressing (not used here)
            CASE %WM_KEYUP   ' Keys at time of release (not used here)
            CASE %WM_CHAR    ' Any character key at time of pressing
                SELECT CASE CBWPARAM ' Holds the code of the key.
                    ' Specify what action should be taken for each key code.
                    CASE 13 ' ENTER pressed
                        CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
                        CONTROL SEND hListForm&,%GridListBox,%LB_SETCURSEL,-1,0 ' deselect cell
                        DIALOG END hEditForm&
                        EXIT FUNCTION
                    CASE 27 ' ESCAPE pressed
                        DIALOG END hEditForm&
                        EXIT FUNCTION
                    CASE ELSE ' No action to be taken here for the other keys.
                END SELECT
        END SELECT
        ' Pass the message on to the original window procedure... the DDT engine!
        FUNCTION = CallWindowProc(gOldSubClassEdit&, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_EditOK
        ' update data array with edited text
        CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
        DIALOG END hEditForm&
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_EditCancel
        DIALOG END hEditForm&
    END FUNCTION
    ------------------

    Comment

    Working...
    X