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 ListView With Row Header

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

  • Virtual ListView With Row Header

    ' version 1
    '
    ' this program presents a virtual listview control with a row header.
    ' listview presents data in a well designed, good looking grid and is
    ' attractive mainly for that reason. in my view its complexity
    ' seriously limits the use for other purposes.

    ' the virtual listview presented here can display two-dimensional
    ' string arrays of any dimensions within the limits of the internal memory.
    ' only the small part of the data being displayed at any one time are
    ' being used by the listbox. all other procedures you need to perform
    ' - including sorting, searching, finding, replacing etc. - can be
    ' done using the data array directly - applying simple, well tested methods
    ' and simple controls. there is no need to use the very complex and
    ' demanding listview control for these operations. furthermore, the
    ' capacity of listview controls is limited and the performance slows
    ' rapidly with increasing amounts of inserted data. therefore, if you
    ' can limit the data to be handled by listview to a low number, the
    ' performance will be good. with the present dimensions of the
    ' virtual listview only 80 items/subitems are being handled at any
    ' time.

    ' one feature which would be desirable for a listview control would
    ' be to edit items and subitems. however, the present version does
    ' not enable you to do that. the necessary listview code is quite
    ' complex and i have not at this time been able to have it working
    ' satisfactorily. however, editing could be performed in a simple
    ' edit control outside the listview, but to elicit this process for
    ' the right item/subitem you need code for responding to a mouse
    ' click over the cell in question. this i have not been able to do
    ' yet.

    ' any idea for implementing editing - in or outside the listview
    ' control - is welcome.
    '
    ' the primary 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.
    '
    ' many thanks to peter redei, david l morris, semen matusovski,
    ' jules marchildon, borje hagsten and lance edmonds for their
    ' contributions in the forum and their inspirational influence
    ' on the present code.
    '
    ' a more effective prevention of internal scroll bars being displayed
    ' has been suggested by semen matusovski. i may implement this in a
    ' later version.
    '
    ' your comments and suggestions for improvement are most welcome here:
    http://www.powerbasic.com/support/pb...ead.php?t=4465
    '
    ' 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"
    '
    %listviewgrid       = 100
    %rowheaderlist      = 110
    %exitbutton         = 115
    %vertscrollbar      = 135
    %horzscrollbar      = 140
    ' --------------------------------------------------
    declare sub showlistdialog(byval hparent&)
    declare callback function listdialogproc
    declare callback function cbf_exit()
    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 columnwidth as long
    global headerwidth as long
    
    global six as scrollinfo
    global siy as scrollinfo
    global prevkey as long      ' previously pressed key
    global goldsubclassproc&
    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/ycr!
    end function
    '
    sub showlistdialog(byval hparent&)
        local clrbk as dword,result as long
        local style&, exstyle&,hctl&,i&,j&
        local x&,y&,x1&,y1&,hdlg&,res&,red&,green&,blue&
    
        local hlistview as long,lstyle as long
        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
        ' accomodation of small and big fonts windows settings
        ' may be improved
        if xcr!<1.75 then ycr!=1.855 else ycr!=1.90
        '
        ' 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)
    
        redim dataarray(1:columns,1:rows)
        redim colhead(1:columns)
        redim rowhead(1:rows)
        ' fill arrays with data
        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&, "virtual listview with row header", 0, 0,xdu(98),ydu(92), style&, exstyle& to hlistform&
        control add "syslistview32",hlistform&,%listviewgrid,",xdu(18.5),ydu(2.6),xdu(71.5),ydu(64.3), _
           %ws_border or %ws_child or %ws_visible or %ws_tabstop or %lvs_report , %ws_ex_clientedge
        control handle hlistform&,%listviewgrid to hlistview
        lstyle = sendmessage(hlistview,%lvm_getextendedlistviewstyle, 0, 0)
        lstyle = lstyle or %lvs_ex_gridlines or %lvs_ex_fullrowselect 'or %lvs_ex_trackselect
        call sendmessage(hlistview, %lvm_setextendedlistviewstyle, 0, byval lstyle)
        control add scrollbar, hlistform&,%horzscrollbar," ,xdu(18.5),ydu(66.6),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(60), _
            %ws_child or %ws_visible or %sbs_vert
        control add "syslistview32",hlistform&,%rowheaderlist,",xdu(1.5),ydu(2.6),xdu(17.2),ydu(64.3), _
           %ws_border or %ws_child or %ws_visible or %ws_tabstop or %lvs_report, %ws_ex_clientedge
        control handle hlistform&,%rowheaderlist to hlistview
        lstyle = sendmessage(hlistview,%lvm_getextendedlistviewstyle, 0, 0)
        lstyle = lstyle or %lvs_ex_gridlines
        call sendmessage(hlistview, %lvm_setextendedlistviewstyle,0, byval lstyle)
        control add button, hlistform&,  %exitbutton,  "e&xit",xdu(80),ydu(75),xdu(10),ydu(4.43), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_exit
        dialog show modeless hlistform& , call listdialogproc
    end sub
    ' --------------------------------------------------
    callback function listdialogproc
        local hctl&, result&,i&,j&,n&
        local cursel&
       ' control set focus hlistform&,%listviewgrid
        select case cbmsg
            case %wm_initdialog
                ' subclass %listviewgrid
                control handle cbhndl, %listviewgrid to hctl&
                goldsubclassproc = setwindowlong(hctl&, %gwl_wndproc, codeptr(subclasskeys))
                '
                ' 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 filllistviewgridandheader(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_thumbposition ',%sb_thumbtrack'
                        ' 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_thumbposition ',%sb_thumbtrack
                        ' 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, goldsubclassproc
                ' -----------------------------------------------
            case else
        end select
            control send hlistform&,%rowheaderlist,%wm_setredraw,%true,0 to result&
            control send hlistform&,%listviewgrid,%wm_setredraw,%true,0 to result&
    end function
    ' --------------------------------------------------
    callback function subclasskeys
        ' 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
                select case cbwparam
                    case %vk_up
                        if prevkey=%vk_up then
                            if prescurspos <= 1 then decr siy.npos  : curscorr=1
                        elseif prevkey<>%vk_down and prevkey<>0 then
                            if prescurspos  = 0 then decr siy.npos  : curscorr=1
                        end if
                    case %vk_down
                        if prevkey=%vk_down then
                            if prescurspos >= pagerows - 2 then incr siy.npos : curscorr=-1
                        elseif prevkey<>%vk_up then
                            if prescurspos  = pagerows - 1 then incr siy.npos : curscorr=-1
                        end if
                    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(goldsubclassproc, cbhndl, cbmsg, cbwparam, cblparam)
    end function
    ' --------------------------------------------------
    sub setlistviewitemtext(byval colpos as long,byval rowpos as long, _
                            byval txt as string, byval idctr as long)
        local szstr as asciiz * 100
        local lvi as lv_item
        local istatus as long
        lvi.iitem = rowpos
        lvi.isubitem = colpos
        lvi.mask = %lvif_text
        lvi.statemask = 0
        szstr = txt
        lvi.psztext = varptr(szstr)
        ' send new text to item/subitem
        control send hlistform&,idctr,%lvm_setitem, 0,varptr(lvi) to istatus
    end sub
    ' ------------------------------------------------
    sub setcolumntext(byval colpos as long,byval txt as string)
        local ztext as asciiz * 100
        local lvc as lv_column
        lvc.mask = %lvcf_text or %lvcf_width 'or %lvcf_subitem or %lvcf_fmt
        ' get relevant data about column structure
        control send hlistform&,%listviewgrid, %lvm_getcolumn, colpos, varptr(lvc)
        lvc.cx = columnwidth ' make sure to maintain original column width
        ztext = txt
        lvc.psztext = varptr(ztext)
        ' send new text to column
        control send hlistform&,%listviewgrid,%lvm_setcolumn, colpos, varptr(lvc)
    end sub
    ' ------------------------------------------------
    sub filllistviewgridandheader(byval xpos as long,byval ypos as long)
        local lvc as lv_column
        local lvi as lv_item
        local ztext as asciiz * 100
        local hlistview as long
        local res&,kk&,jj&
        lvc.mask = %lvcf_fmt or %lvcf_width or %lvcf_text or %lvcf_subitem
        lvc.cchtextmax = 100
        columnwidth = xdu(17.7)*xcr!
        lvc.cx = columnwidth
        ' first make column headers
        for kk& = xpos to xpos+pagecolumns-1
            ' column header text
            lvc.fmt = %lvcfmt_left ' set justification
            ztext = colhead(kk&)
            lvc.psztext = varptr(ztext)
            control send hlistform&,%listviewgrid,%lvm_insertcolumn, kk&, varptr(lvc)
        next
        ' fill %listviewgrid with data - one row at a time
        lvi.mask = %lvif_text
        lvi.psztext = varptr(ztext)
        control handle hlistform&,%listviewgrid to hlistview
        for jj&=ypos to ypos+pagerows-1
            lvi.iitem = jj&-ypos
            for kk& = xpos to xpos+pagecolumns-1
                lvi.isubitem = kk&-xpos
                ztext=dataarray(kk&,jj&)
                if kk&=xpos then listview_insertitem hlistview, lvi else listview_setitem hlistview, lvi
            next
        next
        ' make row header column
        headerwidth = xdu(16.6)*xcr!
        lvc.cx = headerwidth
        lvc.fmt = %lvcfmt_left  ' set justification
        ' column header text
        ztext = "row"
        lvc.psztext = varptr(ztext)
        control send hlistform&,%rowheaderlist,%lvm_insertcolumn, 0, varptr(lvc)
        ' fill %rowheaderlist with data - one row at a time
        control handle hlistform&,%rowheaderlist to hlistview
        for jj&=ypos to ypos+pagerows-1
            lvi.iitem = jj&-ypos
            lvi.isubitem = 0
            ztext=rowhead(jj&)
            listview_insertitem hlistview, lvi
        next
    end sub
    ' ------------------------------------------------
    sub updatewindowandscrollbars(byval xpos as long,byval ypos as long)
        local kk&,jj&,res&,hctl&
        local itemstate as dword
        local itemmask as long
        static yprevpos as long  ' previous y-position (remember between calls)
        static xprevpos as long  ' previous x-position (remember between calls)
        control set focus hlistform&,%listviewgrid
        '
        ' find focused item if any and put its index in prescurspos
        itemmask = %lvis_focused or %lvis_selected
        control handle hlistform&,%listviewgrid to hctl&
        kk& = sendmessage(hctl&, %lvm_getnextitem,-1, maklng(itemmask or %lvni_all, 0))
        prescurspos = 0
        if kk&>-1 then itemstate = itemmask : prescurspos = kk&
        '
        ' maintain column width at original setting
        control send hlistform&,%rowheaderlist,%lvm_setcolumnwidth, 0, maklng(headerwidth, 0)
        for kk&=0 to pagecolumns-1
            control send hlistform&,%listviewgrid,%lvm_setcolumnwidth, kk&, maklng(columnwidth, 0)
        next
        '
        if xpos<>xprevpos or ypos<>yprevpos then ' moved
            control send hlistform&,%listviewgrid,%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 headers
                for kk& = xpos to xpos+pagecolumns-1
                    call setcolumntext(kk&-xpos,colhead(kk&))
                next
            end if
            if ypos<>yprevpos then ' moved in y-direction (vertical)
                control send hlistform&,%rowheaderlist,%wm_setredraw,%false,0 to res&
                ' update vertical scroll bar
                siy.fmask = %sif_pos
                control send hlistform&, %vertscrollbar, %sbm_setscrollinfo, %true, varptr(siy)
                ' update row headers
                for jj&=ypos to ypos+pagerows-1
                    call setlistviewitemtext(0,jj&-ypos,rowhead(jj&),%rowheaderlist)
                next
            end if
            ' update window data
            for jj&=ypos to ypos+pagerows-1
                for kk& = xpos to xpos+pagecolumns-1
                    call setlistviewitemtext(kk&-xpos,jj&-ypos,dataarray(kk&,jj&),%listviewgrid)
                next
            next
        end if
        ' select new corrected position
        call listview_setitemstate (hctl&,prescurspos+curscorr,itemstate,itemmask)
        if prevkey = 0 then ' deselect present cursor position
            call listview_setitemstate (hctl&,prescurspos,0,itemmask)
        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_exit
        local res&
        res&=msgbox ("are you sure?",%mb_yesno or %mb_iconquestion ,"exit program?")
        if res&=%idyes then dialog end hlistform&
    end function
    slight improvements have been made october 25, 2001.



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

  • #2
    erik,

    for edit of sub items in the list view you might have a go at
    incorporating some of the code in:-
    http://www.powerbasic.com/support/pb...ad.php?t=24314

    regards,

    david

    ------------------

    Comment


    • #3
      ' Virtual ListView With Row Header
      '
      ' Version 2
      '
      ' This version enables you to edit cells in the grid. You can select
      ' continuous editing going to the next cell to the right or below. You
      ' use radio buttons to select which editing option to use. The program
      ' has been improved slightly in regard to maintaining the same column width
      ' and thereby preventing the internal scrollbars to appear in the listview
      ' grid.
      '
      ' I thank very much Jules Marchildon, Semen Matusovski and Lance Edmonds for
      ' valuable comments and ideas for the present version.
      ' Thanks also to David L Morris for his pioneer work on listview in the forum.
      '
      ' Best wishes
      '
      ' Erik Christensen, Copenhagen, Denmark ----- e.chr@email.dk
      '
      ' P.S. Nov. 4th: Coding error in Edit section has been corrected.
      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"
      '
      %ListViewGrid       = 100
      %RowHeaderList      = 110
      %ExitButton         = 115
      %VertScrollbar      = 135
      %HorzScrollbar      = 140
      %EditDescript       = 145
      '
      %EditLabel          = 400
      %EditText           = 410
      %EditOK             = 415
      %EditCancel         = 420
      '
      %LabelRadioButtonAction    = 600
      %RadioButtonFinishEditing  = 605
      %RadioButtonEditRight      = 610
      %RadioButtonEditBelow      = 615
      
      ' --------------------------------------------------
      DECLARE SUB ShowListDialog(BYVAL hParent&)
      DECLARE CALLBACK FUNCTION ListDialogProc
      DECLARE CALLBACK FUNCTION CBF_Exit()
      '
      DECLARE CALLBACK FUNCTION EditDialogProc
      DECLARE CALLBACK FUNCTION CBF_EditText()
      DECLARE CALLBACK FUNCTION CBF_EditOK()
      DECLARE CALLBACK FUNCTION CBF_EditCancel()
      '
      DECLARE CALLBACK FUNCTION CBF_RadioButtonFinishEdit()
      DECLARE CALLBACK FUNCTION CBF_RadioButtonEditRight()
      DECLARE CALLBACK FUNCTION CBF_RadioButtonEditBelow()
      '
      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 ColumnWidth AS LONG
      GLOBAL HeaderWidth AS LONG
      
      GLOBAL siX AS SCROLLINFO
      GLOBAL siY AS SCROLLINFO
      GLOBAL PrevKey AS LONG      ' Previously pressed key
      GLOBAL gOldSubClassProc&
      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/YCR!
      END FUNCTION
      '
      SUB ShowListDialog(BYVAL hParent&)
          LOCAL clrBk AS DWORD,Result AS LONG
          LOCAL Style&, ExStyle&,hCtl&,i&,j&
          LOCAL X&,Y&,X1&,Y1&,hDlg&,res&,Red&,Green&,Blue&
      
          LOCAL hListView AS LONG,lstyle AS LONG
          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
          ' Accomodation of small and big Fonts windows settings
          ' May be improved
          IF XCR!<1.75 THEN YCR!=1.855 ELSE YCR!=1.90
          '
          ' 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)
      
          REDIM DataArray(1:Columns,1:Rows)
          REDIM ColHead(1:Columns)
          REDIM RowHead(1:Rows)
          ' Fill arrays with data
          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&, "Virtual ListView With Row Header", 0, 0,XDU(98),YDU(92), Style&, ExStyle& TO hListForm&
          CONTROL ADD "SysListView32",hListForm&,%ListViewGrid,"",XDU(18.5),YDU(2.6),XDU(71.5),YDU(64.3), _
             %WS_BORDER OR %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LVS_REPORT , %WS_EX_CLIENTEDGE
          CONTROL HANDLE hListForm&,%ListViewGrid TO hListView
          lStyle = SendMessage(hListView,%LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
          lStyle = lStyle OR %LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT 'OR %LVS_EX_TRACKSELECT
          CALL SendMessage(hListView, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, BYVAL lStyle)
          CONTROL ADD SCROLLBAR, hListForm&,%HorzScrollbar,"" ,XDU(18.5),YDU(66.6),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(60), _
              %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
          CONTROL ADD "SysListView32",hListForm&,%RowHeaderList,"",XDU(1.5),YDU(2.6),XDU(17.2),YDU(64.3), _
             %WS_BORDER OR %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LVS_REPORT, %WS_EX_CLIENTEDGE
          CONTROL HANDLE hListForm&,%RowHeaderList TO hListView
          lStyle = SendMessage(hListView,%LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
          lStyle = lStyle OR %LVS_EX_GRIDLINES
          CALL SendMessage(hListView, %LVM_SETEXTENDEDLISTVIEWSTYLE,0, BYVAL lStyle)
          CONTROL ADD LABEL, hListForm&, %EditDescript,"Double-click to edit cell", XDU(35),YDU(75),XDU(35),YDU(4.43), _
              %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
          CONTROL ADD BUTTON, hListForm&,  %ExitButton,  "E&xit",XDU(80),YDU(75),XDU(10),YDU(4.43), _
              %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Exit
          DIALOG SHOW MODELESS hListForm& , CALL ListDialogProc
      END SUB
      ' --------------------------------------------------
      CALLBACK FUNCTION ListDialogProc
          LOCAL hCtl&, Result&,i&,j&,N&,KK&
          LOCAL CurSel&,xPlusOne AS LONG
          LOCAL my_LpLvNm AS NM_LISTVIEW PTR
          STATIC TimeFlagC AS SINGLE
          LOCAL TimeC AS SINGLE
          STATIC zText AS ASCIIZ * 255
          LOCAL LVRow AS LONG, LVCol AS LONG
          SELECT CASE CBMSG
              CASE %WM_INITDIALOG
                  ' Subclass %ListViewGrid
                  CONTROL HANDLE CBHNDL, %ListViewGrid TO hCtl&
                  gOldSubClassProc = SetWindowLong(hCtl&,%GWL_WNDPROC, CODEPTR(SubClassKeys))
                  '
                  ' 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 FillListViewGridAndHeader(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_THUMBPOSITION ',%SB_THUMBTRACK'
                          ' 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_THUMBPOSITION ',%SB_THUMBTRACK
                          ' 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)
                  FUNCTION=1: EXIT FUNCTION
              CASE %WM_NOTIFY
                  SELECT CASE LOWRD(CBWPARAM)
                      CASE %ListViewGrid
                          ' This double click section has been inspired by the
                          ' code by David L Morris.
                          my_LpLvNm = CBLPARAM
                          SELECT CASE @my_LpLvNm.hdr.code
                              CASE %NM_DBLCLK
                              'CASE %NM_CLICK ' You can use single click instead if you wnat
                                  'cursor position
                                  LVRow = @my_LpLvNm.iItem
                                  LVCol = @my_LpLvNm.iSubItem
                                  ' Get array indices corresponding to selected cell
                                  SelX = siX.nPos+LVCol
                                  SelY = siY.nPos+LVRow
                                  CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
                                  FUNCTION = 1
                                  EXIT FUNCTION
                              CASE ELSE
                                  ' Maintain column widths at original setting.
                                  ' An unorthodox code to deal with this problem.
                                  ' You may have ideas to improve it.
                                  ' The timer bits have been included to minimize a
                                  ' deterioration of scrolling performance which
                                  ' could otherwise be a result.
                                  TimeC=TIMER
                                  IF TimeC-TimeFlagC > 0.8 THEN
                                      CONTROL SEND hListForm&,%RowHeaderList,%LVM_GETCOLUMNWIDTH, 0,0 TO Result&
                                      IF Result&<>HeaderWidth THEN
                                          CONTROL SEND hListForm&,%RowHeaderList,%LVM_SETCOLUMNWIDTH, 0, MAKLNG(HeaderWidth, 0)
                                      END IF
                                      FOR KK&=0 TO PageColumns-1
                                          CONTROL SEND hListForm&,%ListViewGrid,%LVM_GETCOLUMNWIDTH,KK&,0 TO Result&
                                          IF Result&<>ColumnWidth THEN
                                              CONTROL SEND hListForm&,%ListViewGrid,%LVM_SETCOLUMNWIDTH, KK&, MAKLNG(ColumnWidth, 0)
                                          END IF
                                      NEXT
                                      TimeFlagC = TIMER
                                  END IF
                          END SELECT
                  END SELECT
              CASE %WM_DESTROY
                  ' Important! Remove the subclassing
                  SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassProc
                  ' -----------------------------------------------
              CASE ELSE
          END SELECT
              CONTROL SEND hListForm&,%RowHeaderList,%WM_SETREDRAW,%TRUE,0 TO Result&
              CONTROL SEND hListForm&,%ListViewGrid,%WM_SETREDRAW,%TRUE,0 TO Result&
      END FUNCTION
      ' --------------------------------------------------
      CALLBACK FUNCTION SubClassKeys
          ' 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
                  SELECT CASE CBWPARAM
                      CASE %VK_UP
                          ' Adjustment for "internal" selection movement
                          IF PrevKey=%VK_UP THEN
                              IF PresCursPos <= 1 THEN DECR siY.nPos  : CursCorr=1
                          ELSEIF PrevKey<>%VK_DOWN THEN
                              IF PresCursPos  = 0 THEN DECR siY.nPos  : CursCorr=1
                          END IF
                      CASE %VK_DOWN
                          ' Adjustment for "internal" selection movement
                          IF PrevKey=%VK_DOWN THEN
                              IF PresCursPos >= PageRows - 2 THEN INCR siY.nPos : CursCorr=-1
                          ELSEIF PrevKey<>%VK_UP THEN
                              IF PresCursPos  = PageRows - 1 THEN INCR siY.nPos : CursCorr=-1
                          END IF
                      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(gOldSubClassProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
      END FUNCTION
      ' --------------------------------------------------
      SUB SetListViewItemText(BYVAL ColPos AS LONG,BYVAL RowPos AS LONG, _
                              BYVAL txt AS STRING, BYVAL IDCtr AS LONG)
          LOCAL szStr AS ASCIIZ * 100
          LOCAL lvi AS LV_ITEM
          LOCAL iStatus AS LONG
          lvi.iItem = RowPos
          lvi.iSubItem = ColPos
          lvi.mask = %LVIF_TEXT
          lvi.stateMask = 0
          szStr = txt
          lvi.pszText = VARPTR(szStr)
          ' Send new text to item/subitem
          CONTROL SEND hListForm&,IDCtr,%LVM_SETITEM, 0,VARPTR(lvi) TO iStatus
      END SUB
      ' ------------------------------------------------
      SUB SetColumnText(BYVAL ColPos AS LONG,BYVAL txt AS STRING)
          LOCAL zText AS ASCIIZ * 100
          LOCAL lvc AS LV_COLUMN
          lvc.mask = %LVCF_TEXT OR %LVCF_WIDTH 'OR %LVCF_SUBITEM OR %LVCF_FMT
          ' Get relevant data about column structure
          CONTROL SEND hListForm&,%ListViewGrid, %LVM_GETCOLUMN, ColPos, VARPTR(lvc)
          lvc.cx = ColumnWidth ' make sure to maintain original column width
          zText = txt
          lvc.pszText = VARPTR(zText)
          ' Send new text to column
          CONTROL SEND hListForm&,%ListViewGrid,%LVM_SETCOLUMN, ColPos, VARPTR(lvc)
      END SUB
      ' ------------------------------------------------
      SUB FillListViewGridAndHeader(BYVAL xPos AS LONG,BYVAL yPos AS LONG)
          LOCAL lvc AS LV_COLUMN
          LOCAL lvi AS LV_ITEM
          LOCAL zText AS ASCIIZ * 100
          LOCAL hListView AS LONG
          LOCAL res&,KK&,JJ&
          lvc.mask = %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM
          lvc.cchTextMax = 100
          ColumnWidth = XDU(17.7)*XCR!
          lvc.cx = ColumnWidth
          ' First make column headers
          FOR KK& = xPos TO xPos+PageColumns-1
              ' column header text
              lvc.fmt = %LVCFMT_LEFT ' set justification
              zText = ColHead(KK&)
              LVC.pszText = VARPTR(zText)
              CONTROL SEND hListForm&,%ListViewGrid,%LVM_INSERTCOLUMN, KK&, VARPTR(lvc)
          NEXT
          ' Fill %ListViewGrid with data - one row at a time
          lvi.mask = %LVIF_TEXT
          lvi.pszText = VARPTR(zText)
          CONTROL HANDLE hListForm&,%ListViewGrid TO hListView
          FOR JJ&=yPos TO yPos+PageRows-1
              lvi.iItem = JJ&-yPos
              FOR KK& = xPos TO xPos+PageColumns-1
                  lvi.iSubItem = KK&-xPos
                  zText=DataArray(KK&,JJ&)
                  IF KK&=xPos THEN ListView_InsertItem hListView, lvi ELSE ListView_SetItem hListView, lvi
              NEXT
          NEXT
          ' Make row header column
          HeaderWidth = XDU(16.6)*XCR!
          lvC.cx = HeaderWidth
          lvC.fmt = %LVCFMT_LEFT  ' set justification
          ' Column header text
          zText = "Row"
          LVC.pszText = VARPTR(zText)
          CONTROL SEND hListForm&,%RowHeaderList,%LVM_INSERTCOLUMN, 0, VARPTR(lvc)
          ' Fill %RowHeaderList with data - one row at a time
          CONTROL HANDLE hListForm&,%RowHeaderList TO hListView
          FOR JJ&=yPos TO yPos+PageRows-1
              lvi.iItem = JJ&-yPos
              lvi.iSubItem = 0
              zText=RowHead(JJ&)
              ListView_InsertItem hListView, lvi
          NEXT
      END SUB
      ' ------------------------------------------------
      SUB UpdateWindowAndScrollbars(BYVAL xPos AS LONG,BYVAL yPos AS LONG)
          LOCAL KK&,JJ&,Res&,hCtl&
          LOCAL ItemState AS DWORD
          LOCAL ItemMask AS LONG
          STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
          STATIC xPrevPos AS LONG  ' previous x-position (remember between calls)
          CONTROL SET FOCUS hListForm&,%ListViewGrid
          '
          ' Find focused item if any and put its index in PresCursPos
          ItemMask = %LVIS_FOCUSED OR %LVIS_SELECTED
          CONTROL HANDLE hListForm&,%ListViewGrid TO hCtl&
          KK& = SendMessage(hCtl&, %LVM_GETNEXTITEM,-1, MAKLNG(ItemMask OR %LVNI_ALL, 0))
          PresCursPos = 0
          IF KK&>-1 THEN ItemState = ItemMask : PresCursPos = KK&
          '
          IF xPos<>xPrevPos OR yPos<>yPrevPos THEN ' Moved
              CONTROL SEND hListForm&,%ListViewGrid,%WM_SETREDRAW,%FALSE,0 TO Res&
              ' Update window data
              FOR JJ&=yPos TO yPos+PageRows-1
                  FOR KK& = xPos TO xPos+PageColumns-1
                      CALL SetListViewItemText(KK&-xPos,JJ&-yPos,DataArray(KK&,JJ&),%ListViewGrid)
                  NEXT
              NEXT
              IF yPos<>yPrevPos THEN ' Moved in Y-direction (vertical)
                  CONTROL SEND hListForm&,%RowHeaderList,%WM_SETREDRAW,%FALSE,0 TO Res&
                  ' Update vertical scroll bar
                  siY.fMask = %SIF_POS
                  CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
                  ' Update row headers
                  FOR JJ&=yPos TO yPos+PageRows-1
                      CALL SetListViewItemText(0,JJ&-yPos,RowHead(JJ&),%RowHeaderList)
                  NEXT
              END IF
              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 headers
                  FOR KK& = xPos TO xPos+PageColumns-1
                      CALL SetColumnText(KK&-xPos,ColHead(KK&))
                  NEXT
              END IF
          END IF
          ' Select new corrected position
          CALL ListView_SetItemState (hCtl&,PresCursPos+CursCorr,ItemState,ItemMask)
          IF PrevKey = 0 THEN ' Deselect present cursor position
              CALL ListView_SetItemState (hCtl&,PresCursPos,0,ItemMask)
          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_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, YMaxScr/YCR!-78,  200,  78, 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
          CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
          CONTROL ADD BUTTON, hEditForm&,  %EditOK,  "&OK", 154, 60, 40, 12, _
              %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditOK
          CONTROL ADD BUTTON, hEditForm&,  %EditCancel,  "&Cancel", 104, 60, 40, 12, _
              %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditCancel
          CONTROL ADD LABEL, hEditForm&,  %LabelRadioButtonAction,  "Action After Pressing ENTER or Clicking OK:", 8, 28, 160, 10
          CONTROL ADD OPTION, hEditForm&,  %RadioButtonFinishEditing,  "Finish Editing", 15, 40, 58, 10, _
              %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON OR %WS_GROUP OR %WS_TABSTOP CALL CBF_RadioButtonFinishEdit
          CONTROL ADD OPTION, hEditForm&,  %RadioButtonEditRight,  "Edit Cell to the Right", 15, 52, 86, 10 CALL CBF_RadioButtonEditRight
          CONTROL ADD OPTION, hEditForm&,  %RadioButtonEditBelow,  "Edit Cell Below", 15, 64, 62, 10 CALL CBF_RadioButtonEditBelow
          CONTROL SEND hEditForm&,%RadioButtonFinishEditing,%BM_SETCHECK,%BST_CHECKED,0
          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 %VK_RETURN ' 13 ' ENTER pressed
                          CALL EditingOptionsOnENTERorOK
                          EXIT FUNCTION
                      CASE %VK_ESCAPE ' 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
          CALL EditingOptionsOnENTERorOK
      END FUNCTION
      ' ------------------------------------------------
      SUB EditingOptionsOnENTERorOK
          LOCAL result&,xPlusOne AS LONG
          '
          CONTROL SEND hEditForm&,%RadioButtonFinishEditing,%BM_GETCHECK,0,0 TO result&
          IF result&=%BST_CHECKED THEN ' Finish editing.
              ' update data array with edited text
              CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
              DIALOG END hEditForm&
              PrevKey =1 ' Prevents de-selection of text in update routine.
          END IF
          '
          CONTROL SEND hEditForm&,%RadioButtonEditRight,%BM_GETCHECK,0,0 TO result&
          IF result&=%BST_CHECKED THEN ' Edit cell to the right.
              ' update data array with previously edited text
              CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
              '
              IF SelX>=Columns THEN ' last cell in row - finish editing
                  DIALOG END hEditForm&
              ELSE
                  ' Move to the right
                  INCR SelX : IF SelX > siX.nPos + PageColumns -1 THEN INCR siX.nPos
                  siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
              END IF
              CONTROL SET TEXT hEditForm&,%EditLabel,"Column"+STR$(SelX)+"  Row"+STR$(SelY)
              CONTROL SET TEXT hEditForm&,%EditText, DataArray(SelX,SelY)
              CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
              CONTROL SET FOCUS hEditForm&,%EditText
              PrevKey =1 ' Prevents de-selection of text in update routine.
          END IF
          '
          CONTROL SEND hEditForm&,%RadioButtonEditBelow,%BM_GETCHECK,0,0 TO result&
          IF result&=%BST_CHECKED THEN ' Edit cell below.
              ' update data array with previously edited text
              CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
              IF SelY>=Rows THEN ' last cell in column - finish editing
                  DIALOG END hEditForm&
              ELSE
                  ' Move down
                  INCR SelY : IF SelY > siY.nPos + PageRows -1 THEN INCR siY.nPos
                  siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
              END IF
              CONTROL SET TEXT hEditForm&,%EditLabel,"Column"+STR$(SelX)+"  Row"+STR$(SelY)
              CONTROL SET TEXT hEditForm&,%EditText, DataArray(SelX,SelY)
              CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
              CONTROL SET FOCUS hEditForm&,%EditText
          PrevKey = 0 ' de-select text in update routine.
          END IF
          ' "Rock" window to update listview display.
          ' This double update in two slightly different positions ensures that
          ' update in the window really takes place. You may have a better method.
          IF siX.nPos < siX.nMax - siX.nPage + 1 THEN xPlusOne=siX.nPos+1 ELSE xPlusOne=siX.npos-1
          CALL UpdateWindowAndScrollbars(xPlusOne,siY.nPos)
          CALL UpdateWindowAndScrollbars(siX.nPos,siY.nPos)
      END SUB
      ' ------------------------------------------------
      CALLBACK FUNCTION CBF_EditCancel
          DIALOG END hEditForm&
      END FUNCTION
      ' ------------------------------------------------
      CALLBACK FUNCTION CBF_RadioButtonFinishEdit
          CONTROL SET FOCUS hEditForm&,%EditText
      END FUNCTION
      ' ------------------------------------------------
      CALLBACK FUNCTION CBF_RadioButtonEditRight
          CONTROL SET FOCUS hEditForm&,%EditText
      END FUNCTION
      ' ------------------------------------------------
      CALLBACK FUNCTION CBF_RadioButtonEditBelow
          CONTROL SET FOCUS hEditForm&,%EditText
      END FUNCTION
      ' ------------------------------------------------
      ' P.S. Nov. 4th: Coding error in Edit section has been corrected.



      [This message has been edited by Erik Christensen (edited November 04, 2001).]

      Comment


      • #4
        ' Virtual ListView With Row Header
        '
        ' Version 3
        '
        ' In this version the row header is integrated in the listview grid. Thus
        ' only one listview control is being used. This means some simplification.
        ' This version holds the column width in an array. This gives the basis for
        ' varying width from column to column. You may wish this at some stage.
        '
        ' For effective hiding of the internal scroll bars of listview a special
        ' technique proposed in the Forum by Semen Matusovski is being used. With
        ' this elegant technique the internal scroll bars are being hidden behind
        ' the edge of a slightly smaller superimposed window. I thank Semen very
        ' much for making this available to the Forum.
        '
        ' This version has the same editing facilities as the previous. However,
        ' at present the row headers cannot be edited. You may easily change this.
        '
        ' Any ideas for further improvement are most welcome at the address
        ' specified in the first version.
        '
        ' Best wishes
        '
        ' Erik Christensen, Copenhagen, Denmark ----- e.chr@email.dk
        '
        ' P.S. Nov. 4th: A few errors have been been corrected, mainly in the
        ' Edit section.
        Code:
        #COMPILE EXE
        #REGISTER NONE
        #DIM ALL
        '#DEBUG ERROR ON
        %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"
        '
        %ListViewGrid       = 100
        %ExitButton         = 115
        %VertScrollbar      = 135
        %HorzScrollbar      = 140
        %EditDescript       = 145
        '
        %EditLabel          = 400
        %EditText           = 410
        %EditOK             = 415
        %EditCancel         = 420
        '
        %LabelRadioButtonAction    = 600
        %RadioButtonFinishEditing  = 605
        %RadioButtonEditRight      = 610
        %RadioButtonEditBelow      = 615
        ' --------------------------------------------------
        DECLARE SUB ShowListDialog(BYVAL hParent&)
        DECLARE CALLBACK FUNCTION CBF_Exit()
        DECLARE CALLBACK FUNCTION ListFrameCallBack()
        DECLARE CALLBACK FUNCTION ListViewWindowCallBack()
        DECLARE SUB UpdateWindowAndScrollbars (BYVAL xPos AS LONG,BYVAL yPos AS LONG)
        '
        DECLARE CALLBACK FUNCTION EditDialogProc
        DECLARE CALLBACK FUNCTION CBF_EditText()
        DECLARE CALLBACK FUNCTION CBF_EditOK()
        DECLARE CALLBACK FUNCTION CBF_EditCancel()
        '
        DECLARE CALLBACK FUNCTION CBF_RadioButtonFinishEdit()
        DECLARE CALLBACK FUNCTION CBF_RadioButtonEditRight()
        DECLARE CALLBACK FUNCTION CBF_RadioButtonEditBelow()
        ' --------------------------------------------------
        GLOBAL Brush&
        GLOBAL hListForm&           ' Dialog handle
        GLOBAL hListFrame&          ' Dialog handle
        GLOBAL hListWindow&         ' 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 ColWidth() AS LONG   ' Column width array
        
        GLOBAL siX AS SCROLLINFO
        GLOBAL siY AS SCROLLINFO
        GLOBAL PrevKey AS LONG      ' Previously pressed key
        GLOBAL gOldSubClassProc&
        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 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/YCR!
        END FUNCTION
        '
        ' --------------------------------------------------
        FUNCTION PBMAIN
            LOCAL hDC AS LONG
            LOCAL Count&
            LOCAL clrBk AS DWORD,Result AS LONG
            LOCAL Style&, ExStyle&,hCtl&,i&,j&
            LOCAL X&,Y&,X1&,Y1&,hDlg&,res&,Red&,Green&,Blue&
            LOCAL CC1 AS INIT_COMMON_CONTROLSEX
            CC1.dwSize=SIZEOF(CC1)
            CC1.dwICC=%ICC_WIN95_CLASSES
            InitCommonControlsEX CC1
        
            LOCAL hListView AS LONG,lstyle AS LONG
            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
            ' Accomodation of small and big Fonts windows settings
            ' May be improved
            IF XCR!<1.75 THEN YCR!=1.855 ELSE YCR!=1.90
            '
            ' Specification of size of array.
            ' You may test other sizes.
            Rows=100
            Columns=500
            '
            ' Grid routines are made for arrays no less than (5,20)
            Columns=MAX(5,Columns)
            Rows=MAX(20,Rows)
        
            REDIM DataArray(0:Columns,0:Rows)' Column zero and row zero are used for headers.
            REDIM ColWidth(0:Columns) ' Each column may have it own width if you want that.
            ' Fill arrays with data
            FOR i&=0 TO Columns
                IF i&=0 THEN ColWidth(i&)= XDU(17.2)*XCR! ELSE ColWidth(i&)=XDU(17.7)*XCR!
                FOR j&=0 TO Rows
                    IF i&=0 THEN      ' Column zero is used for row headers.
                        IF j&=0 THEN  ' Label of row header column.
                            DataArray(i&,j&)= " row"
                        ELSE     '    ' Text of row headers.
                            DataArray(i&,j&)= " row"+STR$(j&)
                        END IF
                    ELSE     ' i& >= 1
                        IF j&=0 THEN  ' Row zero is used for column headers.
                            DataArray(i&,j&)= " column"+STR$(i&)
                        ELSE ' j& >= 1  Item/subitem content
                            DataArray(i&,j&)= " column"+STR$(i&)+" row"+STR$(j&)
                        END IF
                    END IF
                NEXT
            NEXT
            Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
            ExStyle& = 0
            ' Create frame window with scroll bars etc.
            DIALOG NEW 0, "Virtual ListView With Integrated Row Header", 0, 0,XDU(98),YDU(92), Style&, ExStyle& TO hListFrame&
            CONTROL ADD SCROLLBAR, hListFrame&,%HorzScrollbar,"" ,XDU(19.0),YDU(66.6),XDU(71.3),YDU(3.7), _
                %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
            CONTROL ADD SCROLLBAR, hListFrame&,%VertScrollbar,"" , XDU(90.0),YDU(6.3),XDU(2.5),YDU(60.5), _
                %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
            CONTROL ADD BUTTON, hListFrame&,  %ExitButton,  "E&xit",XDU(80),YDU(75),XDU(10),YDU(4.43), _
                %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Exit
            CONTROL ADD LABEL, hListFrame&, %EditDescript,"Double-click to edit cell", XDU(35),YDU(75),XDU(35),YDU(4.43), _
                %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
            DIALOG SHOW MODAL hListFrame& CALL ListFrameCallBack
            ' Handle of original frame window is: hListFrame&
        END FUNCTION
        ' --------------------------------------------------
        CALLBACK FUNCTION ListFrameCallBack
            'CBHNDL = hListFrame&
            SELECT CASE CBMSG
                CASE %WM_INITDIALOG
                    '
                    ' 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)
                    '
                    ' Make "viewport" for the listview to be created
                    DIALOG NEW CBHNDL, "", XDU(1.8),YDU(2.9),XDU(88.3),YDU(63.6), %WS_CHILD OR %WS_VISIBLE, TO hListWindow&
                    ' Make this dialog modeless
                    DIALOG SHOW MODELESS hListWindow& CALL ListViewWindowCallBack
                    '
                    ' Fill window with data
                    CALL FillListViewGridAndHeader(siX.nPos,siY.nPos)
                    '
                    SetFocus hListWindow&
                    '
                    FUNCTION=1: EXIT FUNCTION
                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_THUMBPOSITION ',%SB_THUMBTRACK'
                            ' 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)
                    FUNCTION=1: EXIT FUNCTION
                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_THUMBPOSITION ',%SB_THUMBTRACK
                            ' 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)
                    FUNCTION=1: EXIT FUNCTION
            END SELECT
            ' Enable redraw of listView
            SendMessage hListForm&,%WM_SETREDRAW,%TRUE,0
        END FUNCTION
        ' --------------------------------------------------
        CALLBACK FUNCTION ListViewWindowCallBack
            ' Callback Handle CBHNDL is: hListWindow&
            LOCAL rc AS RECT
            LOCAL i&
            LOCAL my_LpLvNm AS NM_LISTVIEW PTR
            LOCAL LVRow AS LONG, LVCol AS LONG
            SELECT CASE CBMSG
                CASE %WM_INITDIALOG
                    '
                    ' ******* This code is due to Semen Matusovski **************
                    GetClientRect CBHNDL, rc
                    '
                    ' Make Listview control with internal scroll bars outside the
                    ' the edge of the created viewport. This has the effect of
                    ' effectively hiding the internal scroll bars.
                    hListForm& = CreateWindowEx(0, "SysListView32", BYVAL 0, _
                       %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT, 0, 0, _
                       rc.nRight + GetSystemMetrics(%SM_CXVSCROLL), _
                       rc.nBottom + GetSystemMetrics(%SM_CYHSCROLL), _
                       CBHNDL, %ListViewGrid, GetModuleHandle(""), BYVAL 0)
                    '
                    i = SendMessage (hListForm&, %ListViewGrid, %LVM_GETEXTENDEDLISTVIEWSTYLE, 0)
                    i = i OR %LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT
                    SendMessage hListForm&, %LVM_SETEXTENDEDLISTVIEWSTYLE, 0, i
                    '
                    GetClientRect hListForm&, rc
                    ' ***********************************************************
                    '
                    ' Subclass %ListViewGrid
                    gOldSubClassProc = SetWindowLong(hListForm&,%GWL_WNDPROC, CODEPTR(SubClassKeys))
                    '
                CASE %WM_NOTIFY
                    SELECT CASE LOWRD(CBWPARAM)
                        CASE %ListViewGrid
                            ' This double click section has been inspired by the
                            ' code by David L Morris.
                            my_LpLvNm = CBLPARAM
                            SELECT CASE @my_LpLvNm.hdr.code
                                CASE %NM_DBLCLK
                                'CASE %NM_CLICK ' You can use single click instead if you wnat
                                    'cursor position
                                    LVRow = @my_LpLvNm.iItem
                                    LVCol = @my_LpLvNm.iSubItem
                                    ' Get array indices corresponding to selected cell
                                    SelX = siX.nPos+LVCol-1 ' adjust for presence of "internal" row header
                                    SelY = siY.nPos+LVRow
                                    ' The row header is not edited in this version.
                                    IF LVCol>0 THEN CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
                                    SetFocus hListForm&
                                    FUNCTION = 1
                                    EXIT FUNCTION
                                CASE ELSE
                            END SELECT
                    END SELECT
                CASE %WM_DESTROY
                    ' Important! Remove the subclassing
                    SetWindowLong hListForm&, %GWL_WNDPROC, gOldSubClassProc
                    ' -----------------------------------------------
                CASE ELSE
            END SELECT
        END FUNCTION
        ' -----------------------------------------------
        CALLBACK FUNCTION SubClassKeys
            ' 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
                    SELECT CASE CBWPARAM
                        CASE %VK_UP
                            ' Adjustment for "internal" selection movement
                            IF PrevKey=%VK_UP THEN
                                IF PresCursPos <= 1 THEN DECR siY.nPos  : CursCorr=1
                            ELSEIF PrevKey<>%VK_DOWN THEN
                                IF PresCursPos  = 0 THEN DECR siY.nPos  : CursCorr=1
                            END IF
                        CASE %VK_DOWN
                            ' Adjustment for "internal" selection movement
                            IF PrevKey=%VK_DOWN THEN
                                IF PresCursPos >= PageRows - 2 THEN INCR siY.nPos : CursCorr=-1
                            ELSEIF PrevKey<>%VK_UP THEN
                                IF PresCursPos  = PageRows - 1 THEN INCR siY.nPos : CursCorr=-1
                            END IF
                        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(gOldSubClassProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
        END FUNCTION
        ' --------------------------------------------------
        SUB SetListViewItemText(BYVAL ColPos AS LONG,BYVAL RowPos AS LONG, _
                                BYVAL txt AS STRING)
            LOCAL szStr AS ASCIIZ * 100
            LOCAL lvi AS LV_ITEM
            lvi.iItem = RowPos
            lvi.iSubItem = ColPos
            lvi.mask = %LVIF_TEXT
            lvi.stateMask = 0
            szStr = txt
            lvi.pszText = VARPTR(szStr)
            ' Send new text to item/subitem
            SendMessage hListForm&,%LVM_SETITEM, 0,VARPTR(lvi)
        END SUB
        ' ------------------------------------------------
        SUB SetColumnText(BYVAL ColPos AS LONG,BYVAL txt AS STRING)
            LOCAL zText AS ASCIIZ * 100
            LOCAL lvc AS LV_COLUMN
            lvc.mask = %LVCF_TEXT OR %LVCF_WIDTH 'OR %LVCF_SUBITEM OR %LVCF_FMT
            ' Get relevant data about column structure
            SendMessage hListForm&, %LVM_GETCOLUMN, ColPos, VARPTR(lvc)
            lvc.cx = ColWidth(ColPos) ' make sure to maintain original column width
            zText = txt
            lvc.pszText = VARPTR(zText)
            ' Send new text to column
            SendMessage hListForm&,%LVM_SETCOLUMN, ColPos, VARPTR(lvc)
        END SUB
        ' ------------------------------------------------
        SUB FillListViewGridAndHeader(BYVAL xPos AS LONG,BYVAL yPos AS LONG)
            LOCAL lvc AS LV_COLUMN
            LOCAL lvi AS LV_ITEM
            LOCAL zText AS ASCIIZ * 100
            LOCAL hListView AS LONG
            LOCAL res&,KK&,JJ&
            lvc.mask = %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM
            lvc.cchTextMax = 100
            ' First make column headers
            FOR KK& = xPos TO xPos+PageColumns ' includes now row header column
                lvc.cx = ColWidth(KK&-1)
                ' column header text
                lvc.fmt = %LVCFMT_LEFT ' set justification
                zText = DataArray(KK&-1,0)
                LVC.pszText = VARPTR(zText)
                SendMessage hListForm&,%LVM_INSERTCOLUMN, KK&, VARPTR(lvc)
            NEXT
            ' Fill %ListViewGrid with data - one row at a time
            lvi.mask = %LVIF_TEXT
            lvi.pszText = VARPTR(zText)
            FOR JJ&=yPos TO yPos+PageRows-1
                lvi.iItem = JJ&-yPos
                FOR KK& = xPos TO xPos+PageColumns'-1
                    lvi.iSubItem = KK&-xPos
                    zText=DataArray(KK&-1,JJ&)
                    IF KK&=xPos THEN ListView_InsertItem hListForm&, lvi ELSE ListView_SetItem hListForm&, lvi
                NEXT
            NEXT
        END SUB
        ' ------------------------------------------------
        SUB UpdateWindowAndScrollbars(BYVAL xPos AS LONG,BYVAL yPos AS LONG)
            LOCAL KK&,JJ&,Res&,hCtl&
            LOCAL ItemState AS DWORD
            LOCAL ItemMask AS LONG
            STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
            STATIC xPrevPos AS LONG  ' previous x-position (remember between calls)
            SetFocus hListForm&
            '
            ' Find focused item if any and put its index in PresCursPos
            ItemMask = %LVIS_FOCUSED OR %LVIS_SELECTED
            KK& = SendMessage(hListForm&, %LVM_GETNEXTITEM,-1, MAKLNG(ItemMask OR %LVNI_ALL, 0))
            PresCursPos = 0
            IF KK&>-1 THEN ItemState = ItemMask : PresCursPos = KK&
            '
            ' Maintain column width at original setting
            SendMessage hListForm&,%LVM_SETCOLUMNWIDTH, 0, MAKLNG(ColWidth(0), 0) ' Row header
            FOR KK& = xPos TO xPos+PageColumns-1
                SendMessage hListForm&,%LVM_SETCOLUMNWIDTH,KK&-xPos+1, MAKLNG(ColWidth(KK&), 0)
            NEXT
            '
            IF xPos<>xPrevPos OR yPos<>yPrevPos THEN ' Moved
                ' Disable redraw while we change listview content
                Res&=SendMessage(hListForm&,%WM_SETREDRAW,%FALSE,0)
                ' Update window data
                FOR JJ&=yPos TO yPos+PageRows-1
                    FOR KK& = xPos TO xPos+PageColumns-1
                        CALL SetListViewItemText(KK&-xPos+1,JJ&-yPos,DataArray(KK&,JJ&))
                    NEXT
                NEXT
                IF xPos<>xPrevPos THEN ' Moved in X-direction (horizontal)
                    ' Update horizontal scroll bar
                    siX.fMask = %SIF_POS
                    CONTROL SEND hListFrame& , %HorzScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siX)
                    ' Update column headers
                    FOR KK& = xPos TO xPos+PageColumns-1
                        CALL SetColumnText(KK&-xPos+1,DataArray(KK&,0))
                    NEXT
                END IF
                IF yPos<>yPrevPos THEN ' Moved in Y-direction (vertical)
                    siY.fMask = %SIF_POS
                    CONTROL SEND hListFrame& , %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
                    ' Update row headers
                    FOR JJ&=yPos TO yPos+PageRows-1
                        CALL SetListViewItemText(0,JJ&-yPos,DataArray(0,JJ&))
                    NEXT
                END IF
            END IF
            ' Select new corrected position
            CALL ListView_SetItemState (hListForm&,PresCursPos+CursCorr,ItemState,ItemMask)
            IF PrevKey = 0 THEN ' Deselect present cursor position
                CALL ListView_SetItemState (hListForm&,PresCursPos,0,ItemMask)
            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_Exit
            LOCAL res&
            res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Exit Program?")
            IF res&=%IDYES THEN DIALOG END hListFrame&
        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, YMaxScr/YCR!-78,  200,  78, 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
            CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
            CONTROL ADD BUTTON, hEditForm&,  %EditOK,  "&OK", 154, 60, 40, 12, _
                %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditOK
            CONTROL ADD BUTTON, hEditForm&,  %EditCancel,  "&Cancel", 104, 60, 40, 12, _
                %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_EditCancel
            CONTROL ADD LABEL, hEditForm&,  %LabelRadioButtonAction,  "Action After Pressing ENTER or Clicking OK:", 8, 28, 160, 10
            CONTROL ADD OPTION, hEditForm&,  %RadioButtonFinishEditing,  "Finish Editing", 15, 40, 58, 10, _
                %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON OR %WS_GROUP OR %WS_TABSTOP CALL CBF_RadioButtonFinishEdit
            CONTROL ADD OPTION, hEditForm&,  %RadioButtonEditRight,  "Edit Cell to the Right", 15, 52, 86, 10 CALL CBF_RadioButtonEditRight
            CONTROL ADD OPTION, hEditForm&,  %RadioButtonEditBelow,  "Edit Cell Below", 15, 64, 62, 10 CALL CBF_RadioButtonEditBelow
            CONTROL SEND hEditForm&,%RadioButtonFinishEditing,%BM_SETCHECK,%BST_CHECKED,0
            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 %VK_RETURN ' 13 ' ENTER pressed
                            CALL EditingOptionsOnENTERorOK
                            EXIT FUNCTION
                        CASE %VK_ESCAPE ' 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
            CALL EditingOptionsOnENTERorOK
        END FUNCTION
        ' ------------------------------------------------
        SUB EditingOptionsOnENTERorOK
            LOCAL result&,xPlusOne AS LONG
            '
            CONTROL SEND hEditForm&,%RadioButtonFinishEditing,%BM_GETCHECK,0,0 TO result&
            IF result&=%BST_CHECKED THEN ' Finish editing.
                ' update data array with edited text
                CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
                DIALOG END hEditForm&
                PrevKey = 1 ' Prevents de-selection of text in update routine.
            END IF
            '
            CONTROL SEND hEditForm&,%RadioButtonEditRight,%BM_GETCHECK,0,0 TO result&
            IF result&=%BST_CHECKED THEN ' Edit cell to the right.
                ' update data array with previously edited text
                CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
                '
                IF SelX>=Columns THEN ' last cell in row - finish editing
                    DIALOG END hEditForm&
                ELSE
                    ' Move to the right
                    INCR SelX : IF SelX > siX.nPos + PageColumns -1 THEN INCR siX.nPos
                    siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                END IF
                CONTROL SET TEXT hEditForm&,%EditLabel,"Column"+STR$(SelX)+"  Row"+STR$(SelY)
                CONTROL SET TEXT hEditForm&,%EditText, DataArray(SelX,SelY)
                CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
                CONTROL SET FOCUS hEditForm&,%EditText
                PrevKey =1 ' Prevents de-selection of text in update routine.
            END IF
            '
            CONTROL SEND hEditForm&,%RadioButtonEditBelow,%BM_GETCHECK,0,0 TO result&
            IF result&=%BST_CHECKED THEN ' Edit cell below.
                ' update data array with previously edited text
                CONTROL GET TEXT hEditForm&,%EditText TO DataArray(SelX,SelY)
                IF SelY>=Rows THEN ' last cell in column - finish editing
                    DIALOG END hEditForm&
                ELSE
                    ' Move down
                    INCR SelY : IF SelY > siY.nPos + PageRows -1 THEN INCR siY.nPos
                    siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                END IF
                CONTROL SET TEXT hEditForm&,%EditLabel,"Column"+STR$(SelX)+"  Row"+STR$(SelY)
                CONTROL SET TEXT hEditForm&,%EditText, DataArray(SelX,SelY)
                CONTROL SEND hEditForm&, %EditText,%EM_SETSEL,0,-1  ' select all text
                CONTROL SET FOCUS hEditForm&,%EditText
            PrevKey = 0 ' de-select text in update routine.
            END IF
            ' "Rock" window to update listview display.
            ' This double update in two slightly different positions ensures that
            ' update in the window really takes place. You may have a better method.
            IF siX.nPos < siX.nMax - siX.nPage + 1 THEN xPlusOne=siX.nPos+1 ELSE xPlusOne=siX.npos-1
            CALL UpdateWindowAndScrollbars(xPlusOne,siY.nPos)
            CALL UpdateWindowAndScrollbars(siX.nPos,siY.nPos)
        END SUB
        ' ------------------------------------------------
        CALLBACK FUNCTION CBF_EditCancel
            DIALOG END hEditForm&
        END FUNCTION
        ' ------------------------------------------------
        CALLBACK FUNCTION CBF_RadioButtonFinishEdit
            CONTROL SET FOCUS hEditForm&,%EditText
        END FUNCTION
        ' ------------------------------------------------
        CALLBACK FUNCTION CBF_RadioButtonEditRight
            CONTROL SET FOCUS hEditForm&,%EditText
        END FUNCTION
        ' ------------------------------------------------
        CALLBACK FUNCTION CBF_RadioButtonEditBelow
            CONTROL SET FOCUS hEditForm&,%EditText
        END FUNCTION
        ' ------------------------------------------------
        ' P.S. Nov. 4th: A few errors have been been corrected, mainly in the
        ' Edit section.
        ' Nov 5th: Some extra comments have been added in the program.


        [This message has been edited by Erik Christensen (edited November 05, 2001).]

        Comment

        Working...
        X