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 listbox with hidden listbox receiving keyboard input

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

  • Virtual listbox with hidden listbox receiving keyboard input

    ' Simple virtual single column listbox with row header - version 2.
    '
    ' The virtual listbox can present a list array of any size.
    ' Only the few currently displayed data are used by the listbox at
    ' any time.
    '
    ' The program applies a scroll bar control and subclassing for processing of
    ' key messages.
    '
    ' 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.
    '
    ' 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.
    '
    ' Thanks to Borje Hagsten and Lance Edmonds for their inspirational influence on
    ' the present code.
    '
    ' 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.
    '
    ' Your comments and suggestions for improvement are most welcome.
    '
    ' 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"
    '
    %ListBox            = 100
    %TextOfListItems    = 105
    %RowHeaderList      = 110
    %ExitButton         = 115
    %RowIdent           = 120
    %VertScrollbar      = 135
    %EditDescript       = 145
    '
    %HiddenListbox      = 150
    '
    %EditLabel          = 400
    %EditText           = 410
    %EditOK             = 415
    %EditCancel         = 420
    ' --------------------------------------------------
    DECLARE SUB ShowListDialog(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION ListDialogProc
    DECLARE SUB EditCellForm(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION CBF_ListBox()
    DECLARE CALLBACK FUNCTION CBF_Exit()
    DECLARE CALLBACK FUNCTION CBF_EditText()
    DECLARE CALLBACK FUNCTION CBF_EditOK()
    DECLARE CALLBACK FUNCTION CBF_EditCancel()
    DECLARE SUB UpdateWindowAndScrollbar (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 PageRows AS LONG     ' Number of rows on a page
    
    GLOBAL DataArray() AS STRING' One dimensional text array to be displayed
    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 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*430*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 size.
        Rows=100000
        '
        ' The listbox routines are made for array no less than (20)
        Rows=MAX(20,Rows)
        REDIM DataArray(1:Rows)
        ' Fill array with data
        FOR j&=1 TO Rows
            DataArray(j&)=" text content of row"+STR$(j&)
        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 Single Column List Box - Version 2", 0, 0,XDU(98),YDU(92), Style&, ExStyle& TO hListForm&
        CONTROL ADD LISTBOX, hListForm&,%ListBox, , XDU(18.5),YDU(6.65),XDU(71.5),YDU(59.41), _
           %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ListBox
        '
        ' 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&,%VertScrollbar,"" , XDU(90.1),YDU(6.65),XDU(4.5),YDU(56.4), _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        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
        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 LABEL, hListForm&,  %RowIdent," Row", XDU(1.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&,  %TextOfListItems," Text",XDU(18.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&, %EditDescript,"Double-click to edit cell", XDU(20),YDU(72),XDU(55),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&,j&,Result&
        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&
                gOldSubClassProc = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassKeys))
                '
                ' Number of rows in a displayed page
                PageRows=20
                '
                ' 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)
                '
                ' Fill window with data
                CALL UpdateWindowAndScrollbar (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))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            CASE %WM_DESTROY
                ' Important! Remove the subclassing
                SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassProc
            ' -----------------------------------------------
            CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE %RowHeaderList
                        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 listbox
        CONTROL SEND hListForm&,%ListBox,%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,%VK_LEFT    : DECR siY.nPos
                    CASE %VK_DOWN,%VK_RIGHT : INCR siY.nPos
                    CASE %VK_PGUP  :   siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %VK_PGDN  :   siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %VK_HOME  :   siY.nPos = 0
                    CASE %VK_END   :   siY.nPos = Rows
                    CASE ELSE
                END SELECT
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (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 UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
        ' Updates the listbox data to be presented after scrolling.
        LOCAL j&,Res&
        STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
        CONTROL SEND hListForm&,%ListBox,%LB_GETCURSEL,0,0 TO PresCursPos
        IF yPos<>yPrevPos THEN ' Moved
            CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
            ' Update vertical scroll bar
            siY.fMask = %SIF_POS
            CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
            '
            CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
            CONTROL SEND hListForm&,%ListBox,%LB_RESETCONTENT,0,0
            FOR j&=yPos TO yPos + PageRows - 1
                ' Update row header list
                LISTBOX ADD hListForm&,%RowHeaderList,STR$(j&)
                ' Update window data
                LISTBOX ADD hListForm&,%ListBox,DataArray(j&)
            NEXT
        END IF
        ' New "previous" position to be remembered for the next update call
        yPrevPos=yPos
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_ListBox
        LOCAL buffer AS ASCIIZ * 256
        LOCAL CVal&
        IF CBCTLMSG=%LBN_SELCHANGE THEN
            ' Set focus back 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
            SelY = siY.nPos + CVal&
            CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
            buffer = DataArray(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)
            CONTROL SEND CBHNDL , CBCTL,%LB_SETCURSEL, CVal&,-1
            ' Set focus back to the hidden listbox
            CONTROL SET FOCUS hListForm&, %HiddenListbox
        END IF
    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
    ' ------------------------------------------------
    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,"  Row"+STR$(SelY), 6, 2, 188, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD TEXTBOX, hEditForm&,  %EditText,  DataArray(SelY), 6, 12, 188, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, _
            %WS_EX_CLIENTEDGE
        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&
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_EditOK
        LOCAL txt$
        CONTROL GET TEXT hEditForm&,%EditText TO txt$
        ' update data array with edited text
        DataArray(SelY)=txt$
        DIALOG END hEditForm&
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_EditCancel
        DIALOG END hEditForm&
    END FUNCTION

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


    [This message has been edited by Erik Christensen (edited October 17, 2001).]

  • #2
    ' This somewhat improved version enables the use of ENTER and ESC to
    ' terminate editing of a cell.
    '
    ' 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.
    '
    ' Semen Matusovski, Borje Hagsten, Adrian Aitken and Lance Edmonds are
    ' thanked for their inspirational influence on the present code.
    '
    ' 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"
    '
    %ListBox            = 100
    %TextOfListItems    = 105
    %RowHeaderList      = 110
    %ExitButton         = 115
    %RowIdent           = 120
    %VertScrollbar      = 135
    %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_ListBox()
    DECLARE CALLBACK FUNCTION CBF_HeaderBox()
    DECLARE CALLBACK FUNCTION CBF_Exit()
    DECLARE CALLBACK FUNCTION CBF_EditText()
    DECLARE CALLBACK FUNCTION CBF_EditOK()
    DECLARE CALLBACK FUNCTION CBF_EditCancel()
    DECLARE SUB UpdateWindowAndScrollbar (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 PageRows AS LONG     ' Number of rows on a page
    
    GLOBAL DataArray() AS STRING' One dimensional text array to be displayed
    GLOBAL siY AS SCROLLINFO
    GLOBAL PrevKey AS LONG      ' Previously pressed key
    GLOBAL gOldSubClassList&
    GLOBAL gOldSubClassEdit&
    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*430*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 size.
        Rows=100000
        '
        ' The listbox routines are made for array no less than (20)
        Rows=MAX(20,Rows)
        REDIM DataArray(1:Rows)
        ' Fill array with data
        FOR j&=1 TO Rows
            DataArray(j&)=" text content of row"+STR$(j&)
        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 Single Column List Box - Version 2", 0, 0,XDU(98),YDU(92), Style&, ExStyle& TO hListForm&
        CONTROL ADD LISTBOX, hListForm&,%ListBox, , XDU(18.5),YDU(6.65),XDU(71.5),YDU(59.41), _
           %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ListBox
        '
        ' 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&,%VertScrollbar,"" , XDU(90.1),YDU(6.65),XDU(4.5),YDU(56.4), _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        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 %WS_BORDER OR %WS_TABSTOP CALL CBF_HeaderBox
        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 LABEL, hListForm&,  %RowIdent," Row", XDU(1.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&,  %TextOfListItems," Text",XDU(18.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&, %EditDescript,"Double-click to edit cell", XDU(20),YDU(72),XDU(55),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&,j&,Result&
        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 in a displayed page
                PageRows=20
                '
                ' 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)
                '
                ' Fill window with data
                CALL UpdateWindowAndScrollbar (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))
                CALL UpdateWindowAndScrollbar (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 %RowHeaderList
                        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 listbox
        CONTROL SEND hListForm&,%ListBox,%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
                SELECT CASE CBWPARAM
                    CASE %VK_UP,%VK_LEFT    : DECR siY.nPos
                    CASE %VK_DOWN,%VK_RIGHT : INCR siY.nPos
                    CASE %VK_PGUP  :   siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %VK_PGDN  :   siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %VK_HOME  :   siY.nPos = 0
                    CASE %VK_END   :   siY.nPos = Rows
                    CASE ELSE
                END SELECT
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (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 UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
        ' Updates the listbox data to be presented after scrolling.
        LOCAL j&,Res&
        STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
        IF yPos<>yPrevPos THEN ' Moved
            CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
            ' Update vertical scroll bar
            siY.fMask = %SIF_POS
            CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
            '
            CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
            CONTROL SEND hListForm&,%ListBox,%LB_RESETCONTENT,0,0
            FOR j&=yPos TO yPos + PageRows - 1
                ' Update row header list
                LISTBOX ADD hListForm&,%RowHeaderList,STR$(j&)
                ' Update window data
                LISTBOX ADD hListForm&,%ListBox,DataArray(j&)
            NEXT
        END IF
        ' New "previous" position to be remembered for the next update call
        yPrevPos=yPos
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_ListBox
        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
            SelY = siY.nPos + CVal&
            CALL EditCellForm(hListForm&) ' Edit cell - new text to data array
            buffer = DataArray(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_HeaderBox
        ' set focus to the hidden listbox
        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?")
        ' set focus to the hidden listbox
        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,"  Row"+STR$(SelY), 6, 2, 188, 10, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD TEXTBOX, hEditForm&,  %EditText,  DataArray(SelY), 6, 12, 188, 12, _
            %WS_CHILD OR %WS_VISIBLE 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(SelY)
                        CONTROL SEND hListForm&,%ListBox,%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(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).]

    Comment

    Working...
    X