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

Keyboard Select For List Box - "Narrow-Down" Selection

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

  • Keyboard Select For List Box - "Narrow-Down" Selection

    ' Keyboard Select For List Box - "Narrow-Down" Selection
    '
    ' This small code demonstrates keyboard selection of items in a
    ' list box. The default window procedure for the predefined list box
    ' window class can carry out some keyboard selection, but this program
    ' takes care of the full process. As soon as only one item matches
    ' the keyboard character sequence, that item is automatically copied
    ' from the list box and used for further processing. Scrolling takes
    ' place automatically. Keyboard scrolling is not used. For illustration
    ' some simple character strings are used. Try typing a simple sequence
    ' like EBBA and see what happens.
    '
    ' Good luck!
    '
    ' September 19, 2003 ------ Erik Christensen ------ e.chr@email.dk
    '
    ' October 4, 2003: Added delay dependent clearing of search string.
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    ' ----------------------------------------------------------
    #INCLUDE  "WIN32API.INC"
    '
    %ID_LISTBOX1        = 100
    %ID_LISTBOX2        = 115
    %ID_BUTTON_EXIT     = 135
    %LABEL7             = 200
    %LABEL6             = 205
    %LABEL5             = 210
    %LABEL4             = 215
    %LABEL3             = 220
    %LABEL2             = 225
    %LABEL1             = 230
    '
    GLOBAL hForm1&
    GLOBAL H&,W&
    '
    FUNCTION A(BYVAL X1 AS LONG) AS LONG
        FUNCTION = X1 * W / 388
    END FUNCTION
    '
    FUNCTION B(BYVAL Y1 AS LONG) AS LONG
        FUNCTION = Y1 * H / 248
    END FUNCTION
    ' --------------------------------------------------------------------------------
    ' Main entry point for the application
    '
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      BYVAL lpCmdLine     AS ASCIIZ PTR, _
                      BYVAL iCmdShow      AS LONG) AS LONG
    
        LOCAL Msg         AS tagMsg
        LOCAL wclass      AS WndClassEx
        LOCAL szClassName AS ASCIIZ * %MAX_PATH
        LOCAL Caption     AS ASCIIZ * 100
    
        ' Register the main application window
        szClassName          = "WINDOWMAIN"
        wclass.cbSize        = SIZEOF(wclass)
        wclass.style         = %CS_HREDRAW OR %CS_VREDRAW
        wclass.lpfnWndProc   = CODEPTR(WndProc)
        wclass.cbClsExtra    = 0
        wclass.cbWndExtra    = 0
        wclass.hInstance     = hInstance
        wclass.hIcon         = LoadIcon(GetModuleHandle(BYVAL 0&), "PROGRAM")
        wclass.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
        wclass.hbrBackground = GetStockObject(%LTGRAY_BRUSH)
        wclass.lpszMenuName  = %NULL
        wclass.lpszClassName = VARPTR(szClassName)
        wclass.hIconSm       = LoadIcon(GetModuleHandle(BYVAL 0&), "PROGRAM")
        RegisterClassEx wclass
    
        ' Adapt window to Work Area on screen (desktop).
        LOCAL rc AS RECT
        SystemParametersInfo %SPI_GETWORKAREA,BYVAL %NULL, BYVAL VARPTR(rc),BYVAL %NULL
        Caption = "Keyboard Select For List Box - ""Narrow-Down"" Selection"
        ' Create a window using the registered class
        hForm1 = CreateWindow(szClassName, _      ' Window class name
            Caption, _                            ' Window caption
            %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER, _ ' Window style
            rc.nLeft, _                           ' Initial x position
            rc.nTop, _                            ' Initial y position
            rc.nRight-rc.nLeft, _                 ' Initial x size
            rc.nBottom-rc.nTop, _                 ' Initial y size
            %HWND_DESKTOP, _                      ' Parent window handle
            BYVAL %NULL, _                        ' Window menu handle
            hInstance, _                          ' Program instance handle
            BYVAL %NULL)                          ' Creation parameters
    
        ' Display the main window
        ShowWindow hForm1, iCmdShow
        UpdateWindow hForm1
        '
        ' SDK-style message pump
        WHILE GetMessage(Msg, %NULL, 0, 0)
            TranslateMessage Msg
            DispatchMessage Msg
        WEND
        '
        ' Return the Process Exit code
        FUNCTION = msg.wParam
    
    END FUNCTION
    '
    '------------------------------------------------------------------------------
    ' Main callback
    '
    CALLBACK FUNCTION WndProc
        STATIC hList1   AS DWORD
        STATIC hList2   AS DWORD
        STATIC hLabel1  AS DWORD
        STATIC hLabel2  AS DWORD
        STATIC hLabel3  AS DWORD
        STATIC hLabel4  AS DWORD
        STATIC hLabel5  AS DWORD
        STATIC hLabel6  AS DWORD
        STATIC hLabel7  AS DWORD
        STATIC hButton  AS DWORD
        STATIC s        AS STRING
        LOCAL rc AS RECT
        STATIC wFirst&, wLast&
        LOCAL i&,j&,k&,l&,Res&
        STATIC Delay#,LastTime#
        SELECT CASE CBMSG
            CASE %WM_CREATE
                GetClientRect CBHNDL, rc : H = rc.nBottom : W = rc.nRight
                hList1 = CreateWindowEx(%WS_EX_CLIENTEDGE, "LISTBOX", BYVAL 0, _
                   %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTIPLESEL OR %LBS_SORT OR %WS_VSCROLL OR %WS_TABSTOP, _
                   A(18),B(18),A(74),B(230),CBHNDL,%ID_LISTBOX1,GetModuleHandle(""),BYVAL 0)
                CONTROL SEND CBHNDL,%ID_LISTBOX1, %WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT), %TRUE
                hList2 = CreateWindowEx(%WS_EX_CLIENTEDGE, "LISTBOX", BYVAL 0, _
                   %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_SORT OR %WS_VSCROLL OR %WS_TABSTOP, _
                   A(294),B(18),A(74),B(230),CBHNDL,%ID_LISTBOX2,GetModuleHandle(""),BYVAL 0)
                CONTROL SEND CBHNDL,%ID_LISTBOX2, %WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT), %TRUE
                hLabel7 = CreateWindow("STATIC","",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _ ' Number of strings found.
                    ,A(182),B(112),A(52),B(12),CBHNDL,%LABEL7,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel7,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel6 = CreateWindow("STATIC","String Selected:",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(106),B(142),A(172),B(12),CBHNDL,%LABEL6,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel6,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel5 = CreateWindow("STATIC","Strings Found:",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(106),B(112),A(74),B(12),CBHNDL,%LABEL5,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel5,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel4 = CreateWindow("STATIC","",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(182),B(84),A(60),B(14),CBHNDL,%LABEL4,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel4,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel3 = CreateWindow("STATIC","Search String:",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(106),B(84),A(72),B(14),CBHNDL,%LABEL3,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel3,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel2 = CreateWindow("STATIC","Selected Items:",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(295),B(4),A(82),B(12),CBHNDL,%LABEL2,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel2,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hLabel1 = CreateWindow("STATIC","Original Items:",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(20),B(4),A(80),B(12),CBHNDL,%LABEL1,GetModuleHandle(""),BYVAL 0)
                SendMessage hLabel1,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                hButton = CreateWindow("BUTTON","Exit",%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                    ,A(168),B(218),A(50),B(18),CBHNDL,%ID_BUTTON_EXIT,GetModuleHandle(""),BYVAL 0)
                SendMessage hButton,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
                '
                ' Fill list box 1 with strings.
                FOR i=65 TO 75
                    FOR j=65 TO 75
                        FOR k=65 TO 75
                            FOR l=65 TO 75
                                LISTBOX ADD CBHNDL,%ID_LISTBOX1,CHR$(i)+CHR$(j)+CHR$(k)+CHR$(l)+" ANDERSEN"
                            NEXT
                        NEXT
                    NEXT
                NEXT
                '
                Delay = 1.1# ' 1.1 seconds delay for clearing of search string. You may chose other delay.
                FUNCTION = 0
                EXIT FUNCTION
                '
            CASE %WM_CHAR ' Character key pressed.
                IF TIMER - LastTime > Delay THEN s ="" ' Clear search string if key is delayed
                LastTime = TIMER ' Update LastTime at each key press
                '
                SetFocus CBHNDL
                '
                ' De-select any selected items.
                CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%FALSE,-1
                CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_SETCURSEL,-1,0
                '
                s = s + UCASE$(CHR$(CBWPARAM)) ' accumulate characters for search string - one at a time.
                ' (Listbox does not distinguish between upper and lover case characters.)
                '
                CONTROL SET TEXT CBHNDL, %LABEL4, s
                CONTROL SET TEXT CBHNDL, %LABEL6, "String Selected:"
                '
                ' Find item(s) beginning with the search string.
                CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_FINDSTRING,-1, STRPTR(s) TO Res&
                IF Res <>%LB_ERR THEN  ' At least one match found.
                    ' Find and select any other matches.
                    wFirst = Res : wLast& = Res& : LOCAL Flag& : Flag = 0
                    DO
                        CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_FINDSTRING,Res, STRPTR(s) TO Res&
                        IF Res& > wFirst THEN wLast& = Res&
                        IF wLast& - wFirst& > 49 THEN Flag = 1
                    LOOP UNTIL Res <= wFirst OR Flag = 1 ' repeat until all matches or more than 50 have been found - avoid indefinite looping!
                    ' Select matching range.
                    CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SELITEMRANGE,%TRUE,MAKLNG(wFirst&,wLast&)
                    ' The following two statements take care of any necessary scrolling.
                    CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%TRUE,wLast&
                    CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%TRUE,wFirst&
                    CONTROL SET TEXT CBHNDL, %LABEL7,STR$(wLast&-wFirst&+1)
                    IF Flag = 1 THEN CONTROL SET TEXT CBHNDL, %LABEL7," >50"
                    '
                    IF wFirst& = wLast& THEN ' Only one match found.
                        ' Then take that!
                        LOCAL txt$
                        LISTBOX GET TEXT CBHNDL,%ID_LISTBOX1 TO txt$
                        CONTROL SET TEXT CBHNDL, %LABEL6,"String Selected: " + txt$
                        CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_FINDSTRINGEXACT,-1,STRPTR(txt$) TO Res&
                        IF Res = %LB_ERR THEN ' Only add to list box 2 if not allready there
                            LISTBOX ADD CBHNDL,%ID_LISTBOX2, txt$
                            CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_FINDSTRINGEXACT,-1,STRPTR(txt$) TO Res&
                        END IF
                        CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_SETCURSEL,Res&,0 ' Select new item or old identical item
                        ' Clear search string.
                        s = ""
                        BEEP : BEEP
                    END IF
                ELSE
                    ' Clear search string.
                    s = ""
                    CONTROL SET TEXT CBHNDL, %LABEL7,"0"
                END IF
                FUNCTION = 0
                EXIT FUNCTION
                '
            CASE %WM_KILLFOCUS ' Activated by clicking on listbox
                IF CBWPARAM = hList1 THEN ' Handle of new focus is hList1
                    CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%FALSE,-1 ' de-select all items.
                END IF
                FUNCTION = 0
                EXIT FUNCTION
                '
            CASE %WM_COMMAND
                SELECT CASE CBCTL
                    CASE %ID_LISTBOX1
                        IF CBCTLMSG=%LBN_SELCHANGE THEN
                            CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_GETCURSEL,0,0 TO Res&
                            LISTBOX GET TEXT CBHNDL,%ID_LISTBOX1 TO txt$
                            CONTROL SET TEXT CBHNDL, %LABEL6,"String Selected: " + txt$
                            CONTROL SET TEXT CBHNDL, %LABEL7,""
                            CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%FALSE,-1 ' de-select all items.
                            CONTROL SEND CBHNDL,%ID_LISTBOX1,%LB_SETSEL,%TRUE,Res& ' Set new selected item.
                            CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_SETCURSEL,-1,0  ' Deselect item
                            CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_FINDSTRINGEXACT,-1,STRPTR(txt$) TO Res&
                            IF Res = %LB_ERR THEN ' Only add to list box 2 if not allready there
                                LISTBOX ADD CBHNDL,%ID_LISTBOX2, txt$
                                CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_FINDSTRINGEXACT,-1,STRPTR(txt$) TO Res&
                            END IF
                            CONTROL SEND CBHNDL,%ID_LISTBOX2,%LB_SETCURSEL,Res&,0 ' Select new item or old identical item
                            SetFocus CBHNDL
                            s = ""
                            CONTROL SET TEXT CBHNDL, %LABEL4,""
                        END IF
                    CASE %ID_LISTBOX2
                        IF CBCTLMSG=%LBN_SELCHANGE THEN SetFocus CBHNDL
                    CASE %ID_BUTTON_EXIT
                        IF CBCTLMSG=%BN_CLICKED THEN PostQuitMessage 0
                END SELECT
                FUNCTION = 0
                EXIT FUNCTION
                '
            CASE %WM_DESTROY
                PostQuitMessage 0
                FUNCTION = 0
                EXIT FUNCTION
    
        END SELECT
    
        ' Pass unprocessed messages on to the default handler
        FUNCTION = DefWindowProc(CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    
    END FUNCTION
    [This message has been edited by Erik Christensen (edited October 04, 2003).]

  • #2
    FYI: Added delay dependent clearing of search string.

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

    Comment

    Working...
    X