Listbox with checkbox

[Blaise Wrenn]

Fixed Toggle Button

The following fleshes out the variable names, prunes unused variables and code, reverses the state of selected items when the toggle key is clicked, (rather than just selecting or deselecting all items) and extracts the selected items just before exiting. Thanks for techniques from Chris B. and Borje H.

#COMPILE EXE
#DIM ALL
#IF NOT %DEF(%WINAPI)
  #INCLUDE "WIN32API.INC"
#ENDIF

MACRO NomClickToggle    = 1001
MACRO NomCheckList      = 1002

MACRO TRUE              = -1  ' PowerBasic Version of the truth
MACRO API_TRUE          =  1  ' MicroSoft API Version of the truth
MACRO FALSE             =  0  ' Something everyone can agree upon

'============================================================================================================================
FUNCTION PBMAIN()
  ShowCHECKLIST %HWND_DESKTOP
END FUNCTION
'============================================================================================================================
CALLBACK FUNCTION CallbackChecklist()
  DIM   ItemIndex             AS LONG
  DIM   ItemCount             AS STATIC LONG
  ItemCount = 20
  REDIM ItemLabel(ItemCount)  AS STATIC STRING

  SELECT CASE CB.MSG
    CASE %WM_INITDIALOG                      : GOSUB LoadChecklistDialog
    CASE %WM_CTLCOLORLISTBOX                 : GOSUB GetListboxColor
    CASE %WM_COMMAND                         : GOSUB ProcessWindowsCommand
    CASE %WM_DRAWITEM                        : GOSUB ProcessDrawMessage
    CASE %WM_DESTROY                         : GOSUB KillChecklistDialog
  END SELECT
  EXIT FUNCTION
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
LoadChecklistDialog:
  FOR ItemIndex = 01 TO ItemCount
    ItemLabel( ItemIndex ) = "Item " + STR$( ItemIndex )
    LISTBOX ADD CB.HNDL, NomCheckList, ItemLabel( ItemIndex )
  NEXT ItemIndex
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
GetListboxColor:
  IF CB.LPARAM = GetDlgItem( CB.HNDL, NomCheckList ) THEN FUNCTION = GetSysColorBrush( %COLOR_MENU )
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ProcessWindowsCommand:
  SELECT CASE CB.CTL
    CASE NomClickToggle   : GOSUB ProcessToggleClick
  END SELECT
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ProcessToggleClick:
  DIM FlagToggle AS LONG
  FlagToggle = TRUE
  CALL ChecklistCheckAll( CB.HNDL, NomCheckList, FlagToggle )
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ProcessDrawMessage:
  IF (CB.WPARAM = NomCheckList) THEN
    ChecklistDrawItem GetDlgItem(CB.HNDL, NomCheckList), CB.WPARAM, CB.LPARAM
  END IF
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
KillChecklistDialog:
  LOCAL CountSelected   AS LONG
  LOCAL LimitSelected   AS LONG
  LOCAL IndexSelected   AS LONG
  LOCAL TextLength      AS LONG
  LOCAL TagChecklist    AS DWORD
  LOCAL ItemText        AS STRING
  LOCAL Result          AS STRING

  TagChecklist  = GetDlgItem( CB.HNDL, NomChecklist )

  CountSelected = SendMessage( TagChecklist, %LB_GETSELCOUNT, 0, 0 )
  IF CountSelected > 0 AND CountSelected <> %LB_ERR THEN
    LimitSelected = CountSelected - 1
    REDIM ItemsSelected( LimitSelected ) AS LONG
    SendMessage( TagChecklist, %LB_GETSELITEMS, CountSelected, VARPTR( ItemsSelected(0) ) )
    Result = ""
    FOR IndexSelected = 0 TO LimitSelected
      TextLength = SendMessage( TagChecklist, %LB_GETTEXTLEN, ItemsSelected(IndexSelected), 0 )
      ItemText   = SPACE$( TextLength )
      SendMessage( TagChecklist, %LB_GETTEXT, ItemsSelected(IndexSelected), STRPTR( ItemText )  )
      Result &= ItemText & $CRLF
    NEXT IndexSelected
    MSGBOX Result
  ELSE
    MSGBOX "No items were selected"
  END IF
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END FUNCTION
'----------------------------------------------------------------------------------------------------------------------------
FUNCTION ChecklistDrawItem( BYVAL TagWindow AS LONG, _
                            BYVAL wParam    AS LONG, _
                            BYVAL lParam    AS LONG  _
                          ) AS LONG

  DIM ItemBox      AS RECT
  DIM ItemIndex    AS LONG
  DIM ItemText     AS ASCIIZ * 64
  DIM ItemGroup    AS DRAWITEMSTRUCT PTR
  DIM ItemState    AS LONG

  ItemGroup = lParam
  IF @ItemGroup.itemID = &HFFFFFFFF& THEN EXIT FUNCTION
  SELECT CASE @ItemGroup.itemAction
    CASE %ODA_DRAWENTIRE, %ODA_SELECT   : GOSUB DrawListboxRow
  END SELECT
  EXIT FUNCTION
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DrawListboxRow:
  ' DRAW BACKGROUND
  FillRect @ItemGroup.hDC, @ItemGroup.rcItem, GetSysColorBrush( %COLOR_MENU  )
  ' DRAW TEXT
  SetBkColor   @ItemGroup.hDC, GetSysColor( %COLOR_MENU  )                          '  Set text Background
  SetTextColor @ItemGroup.hDC, GetSysColor( %COLOR_INFOTEXT )                       '  Set text color
  SendMessage TagWindow, %LB_GETTEXT, @ItemGroup.itemID, VARPTR(ItemText)           '  Get text
  TextOut @ItemGroup.hDC, 18, @ItemGroup.rcItem.ntop + 2, ItemText, LEN(ItemText)   '  Draw text
  ' DRAW CHECKBOX
  ItemBox.nLeft   =  2
  ItemBox.nRight  = 15
  ItemBox.ntop    = @ItemGroup.rcItem.ntop + 2
  ItemBox.nbottom = @ItemGroup.rcItem.nbottom - 1
  ItemState = SendMessage ( TagWindow, %LB_GETSEL, @ItemGroup.itemID, 0 )
  IF ISTRUE ItemState THEN
    DrawFrameControl @ItemGroup.hDC, ItemBox, %DFC_BUTTON, %DFCS_BUTTONCHECK OR %DFCS_CHECKED
  ELSE
    DrawFrameControl @ItemGroup.hDC, ItemBox, %DFC_BUTTON, %DFCS_BUTTONCHECK
  END IF
  FUNCTION = -1
  RETURN
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END FUNCTION
'----------------------------------------------------------------------------------------------------------------------------
SUB ChecklistCheckAll( TagWindow AS LONG, NomListbox AS LONG, FlagToggle AS LONG)
  DIM ItemIndex    AS LONG
  DIM ItemCount    AS LONG
  DIM ItemLimit    AS LONG
  DIM ItemState    AS LONG
  DIM TagChecklist AS LONG

  GetDlgItem TagWindow, NomListbox TO TagChecklist
  SendMessage TagChecklist, %LB_GETCOUNT, 0, 0 TO ItemCount
  ItemLimit = ItemCount - 1
  FOR ItemIndex = 0 TO ItemLimit
    ItemState = SendMessage( TagChecklist, %LB_GETSEL, ItemIndex, 0 )
    IF ISTRUE FlagToggle THEN
      IF ISTRUE ItemState THEN
        ItemState = FALSE
      ELSE
        ItemState = API_TRUE
      END IF
    END IF
    SendMessage TagChecklist, %LB_SETSEL, ItemState, ItemIndex
  NEXT ItemIndex
  UpdateWindow TagChecklist
END SUB
'----------------------------------------------------------------------------------------------------------------------------
FUNCTION ShowChecklist( BYVAL TagParent AS DWORD ) AS LONG

  LOCAL Result       AS LONG
  LOCAL TagChecklist AS DWORD
  LOCAL ChecklistStyle1, ChecklistStyle2, ListBoxStyle1, ListBoxStyle2 AS LONG

  ChecklistStyle1 = %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
                    %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT
  ChecklistStyle2 = %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR


  ListBoxStyle1   = %WS_CHILD OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR %WS_TABSTOP OR %LBS_DISABLENOSCROLL OR _
                    %WS_VSCROLL OR %WS_VISIBLE OR %LBS_MULTIPLESEL
  ListBoxStyle2   = %WS_EX_CLIENTEDGE

  DIALOG NEW TagParent, "Checklist", 266, 222, 276, 171, ChecklistStyle1, ChecklistStyle2 TO TagChecklist

  CONTROL ADD BUTTON,  TagChecklist, NomClickToggle, "Toggle", 5,  5 , 55,  15
  CONTROL ADD LISTBOX, TagChecklist, NomCheckList, ,           5, 25, 265, 140, ListBoxStyle1, ListBoxStyle2
  DIALOG SHOW MODAL    TagChecklist, CALL CallbackChecklist TO Result

  FUNCTION = Result
END FUNCTION
'----------------------------------------------------------------------------------------------------------------------------

[Chris Boss]

Much easier way to handle how control stores check box state:

Use the LBS_MULTIPLESEL window style and make the listbox a multi-select listbox. It can be used with ownerdraw.

Then use the selection state as the indicator of whether an item is checked or not.

Then use the LB_GETSEL message in the ownerdraw code to determine whether the item is selected or not. Selected items are considered checked and unselected items are considered uncheck.

This is much easier to code and requires less code.

#COMPILE EXE
#DIM ALL
#IF NOT %DEF(%WINAPI)
   #INCLUDE "WIN32API.INC"
#ENDIF
%IDD_CHECKLIST    = 101
%IDC_BT_TOGGLE    = 1001
%IDC_LB_CHECKLIST = 1002
DECLARE CALLBACK FUNCTION ShowCHECKLISTProc()
DECLARE FUNCTION SampleListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL lCount AS LONG) AS LONG
DECLARE FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG
DECLARE FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
'
'--------------------------------------------------------------------------------
'
FUNCTION PBMAIN()
   ShowCHECKLIST %HWND_DESKTOP
END FUNCTION
'
'--------------------------------------------------------------------------------
'
CALLBACK FUNCTION ShowCHECKLISTProc()
   DIM lRes          AS LONG
   DIM ln            AS LONG        '  return checkbox status
   DIM i_LB          AS LONG
   DIM N_LB          AS STATIC LONG    : N_LB = 20
   REDIM S_LB(N_LB)  AS STATIC STRING
   SELECT CASE CBMSG
      CASE %WM_INITDIALOG
         FOR i_LB = 01 TO N_LB
            S_LB(i_LB) = "Item " + STR$(i_LB)
            LISTBOX ADD CBHNDL, %IDC_LB_CHECKLIST, S_LB(i_LB)
         NEXT i_LB
      CASE %WM_CTLCOLORLISTBOX
         IF CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) OR CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) THEN
            FUNCTION = GetSysColorBrush(%COLOR_MENU  )
         END IF
      CASE %WM_LBUTTONDBLCLK
         CALL ProcessDialog_LBC_Check_GET(CBHNDL, %IDC_LB_CHECKLIST)
      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE %IDC_BT_TOGGLE
               DIM L_LB AS STATIC LONG
               L_LB = NOT L_LB
               CALL ProcessDialog_LBC_Check_ALL(CBHNDL, %IDC_LB_CHECKLIST, L_LB)
            CASE %IDC_LB_CHECKLIST
         END SELECT
      CASE %WM_DESTROY
      CASE %WM_DRAWITEM, %WM_MEASUREITEM     '  Pass these on to ProcessDialog_LBC
         IF CBWPARAM = %IDC_LB_CHECKLIST THEN
            ProcessDialog_LBC GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST), CBMSG, CBWPARAM, CBLPARAM
            EXIT FUNCTION
         END IF
   END SELECT
END FUNCTION
'
FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
   DIM pt      AS POINTAPI
   DIM rc      AS RECT
   DIM i_LB    AS LONG
   DIM L_LB    AS LONG
   DIM hCtrl   AS LONG
   DIM lpdis   AS DRAWITEMSTRUCT PTR
   DIM zTxt    AS ASCIIZ * 64
   hCtrl = GetWindowLong(hWnd, %GWL_ID)
   SELECT CASE wMsg
      CASE %WM_DRAWITEM
         lpdis = lParam
         IF @lpdis.itemID = &HFFFFFFFF& THEN EXIT FUNCTION
         SELECT CASE @lpdis.itemAction
            CASE %ODA_DRAWENTIRE, %ODA_SELECT
               '  DRAW BACKGROUND
               FillRect @lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_MENU  )
              '   DRAW TEXT
               SetBkColor   @lpdis.hDC, GetSysColor(%COLOR_MENU  )               '  Set text Background
               SetTextColor @lpdis.hDC, GetSysColor(%COLOR_INFOTEXT)             '  Set text color
               SendMessage hWnd, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)        '  Get text
               TextOut @lpdis.hDC, 18, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)   '  Draw text
               '  DRAW CHECKBOX
               rc.nLeft   = 02 : rc.nRight = 15                                  '  Set cordinates
               rc.ntop    = @lpdis.rcItem.ntop + 2
               rc.nbottom = @lpdis.rcItem.nbottom - 1
               IF SendMessage (hWnd, %LB_GETSEL,@lpdis.itemID, 0) THEN
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK OR %DFCS_CHECKED
               ELSE
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK
               END IF
               FUNCTION = -1
               EXIT FUNCTION
         END SELECT
   END SELECT
END FUNCTION
'
'--------------------------------------------------------------------------------
'
FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG
   LOCAL lRslt AS LONG
   LOCAL hDlg AS DWORD
   DIALOG NEW hParent, "Checklist", 266, 222, 276, 171, %WS_POPUP OR %WS_BORDER _
      OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
      %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
      %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
   CONTROL ADD BUTTON, hDlg, %IDC_BT_TOGGLE, "Toggle", 5, 5, 55, 15
   CONTROL ADD LISTBOX, hDlg, %IDC_LB_CHECKLIST, , 5, 25, 265, 140, %WS_CHILD OR _
      %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR %WS_TABSTOP OR _
      %LBS_DISABLENOSCROLL OR %WS_VSCROLL OR %WS_VISIBLE OR %LBS_MULTIPLESEL, %WS_EX_CLIENTEDGE
   DIALOG SHOW MODAL hDlg, CALL ShowCHECKLISTProc TO lRslt
   FUNCTION = lRslt
END FUNCTION
'
'--------------------------------------------------------------------------------
'
SUB ProcessDialog_LBC_Check_GET(hDlg AS LONG, hCtr_LB AS LONG)
   DIM i_LB    AS LONG
   DIM N_LB    AS LONG
   DIM L_LB    AS LONG
   DIM hWnd    AS LONG
   LOCAL T$
   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB
   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_GETSEL, i_LB, 00 TO L_LB      '  set toggled item data
      T$=T$+"Item # "+STR$(i_LB) +" = "+ STR$(L_LB)+CHR$(13)+CHR$(10)
   NEXT i_LB
   MSGBOX T$
END SUB
'
'--------------------------------------------------------------------------------
'
SUB ProcessDialog_LBC_Check_ALL(hDlg AS LONG, hCtr_LB AS LONG, L_LB AS LONG)
   DIM i_LB    AS LONG
   DIM N_LB    AS LONG
   DIM hWnd    AS LONG
   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB
   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_SETSEL, L_LB, i_LB      '  set toggled item data
   NEXT i_LB
   UpdateWindow hWnd
END SUB

Got rid of the subclassing too, since not needed in this version.

Now for apps which are themed though, you will have to use Theme API's to draw the checkboxes if you want them to look themed, but thats a different discussion altogether.

[Nicolas MOUGIN]

Initially checked

Found the answer after a while : checking a line is done with value -1 and not 1...

      CASE %WM_INITDIALOG
         FOR i_LB = 01 TO N_LB
            S_LB(i_LB) = "Item " + STR$(i_LB)
            LISTBOX ADD CBHNDL, %IDC_LB_CHECKLIST, S_LB(i_LB)
            IF i_LB MOD 5 = 0 THEN
                SendMessage hWnd, %LB_SETITEMDATA, i_LB - 1, [COLOR="Red"][B]-1[/B][/COLOR] ' set toggled item data
                InvalidateRect hWnd, BYVAL %NULL, 00
                UpdateWindow hWnd
            END IF
         NEXT i_LB

[Nicolas MOUGIN]

Listbox with checkbox

Hi Dean and all, thanks for this pretty nice piece of code.
I seem however to face an issue when trying to populate the listbox with initially checked values : these values cannot be unchecked afterwards...

#COMPILE EXE
#DIM ALL

'--------------------------------------------------------------------------------
'   ** Includes **
'--------------------------------------------------------------------------------
#IF NOT %DEF(%WINAPI)
   #INCLUDE "WIN32API.INC"
#ENDIF
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Constants **
'--------------------------------------------------------------------------------
%IDD_CHECKLIST    = 101
%IDC_BT_TOGGLE    = 1001
%IDC_LB_CHECKLIST = 1002
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Declarations **
'--------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowCHECKLISTProc()
DECLARE FUNCTION SampleListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
   lCount AS LONG) AS LONG
DECLARE FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG
'--------------------------------------------------------------------------------

   GLOBAL LBCProcess_XX AS DWORD    '  for subclassing, to store original LB procedure address
   DECLARE FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

'--------------------------------------------------------------------------------
FUNCTION PBMAIN()
   ShowCHECKLIST %HWND_DESKTOP
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ShowCHECKLISTProc()

   DIM lRes          AS LONG
   DIM ln            AS LONG        '  return checkbox status
   DIM i_LB          AS LONG
   DIM N_LB          AS STATIC LONG    : N_LB = 20
   REDIM S_LB(N_LB)  AS STATIC STRING
   DIM hWnd          AS LONG

   GetDlgItem CBHNDL, %IDC_LB_CHECKLIST TO hWnd

   SELECT CASE CBMSG

      CASE %WM_INITDIALOG
         FOR i_LB = 01 TO N_LB
            S_LB(i_LB) = "Item " + STR$(i_LB)
            LISTBOX ADD CBHNDL, %IDC_LB_CHECKLIST, S_LB(i_LB)
            IF i_LB MOD 5 = 0 THEN
                SendMessage hWnd, %LB_SETITEMDATA, i_LB - 1, 1 ' set toggled item data
                InvalidateRect hWnd, BYVAL %NULL, 00
                UpdateWindow hWnd
            END IF
         NEXT i_LB

      CASE %WM_CTLCOLORLISTBOX
         IF CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) OR CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) THEN
            FUNCTION = GetSysColorBrush(%COLOR_MENU  )
           'FUNCTION = GetSysColorBrush(%COLOR_INFOBK)
         END IF

      CASE %WM_LBUTTONDBLCLK
         CALL ProcessDialog_LBC_Check_GET(CBHNDL, %IDC_LB_CHECKLIST)

      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE %IDC_BT_TOGGLE
               DIM L_LB AS STATIC LONG
               L_LB = NOT L_LB
               CALL ProcessDialog_LBC_Check_ALL(CBHNDL, %IDC_LB_CHECKLIST, L_LB)

            CASE %IDC_LB_CHECKLIST
               IF HIWRD(CBWPARAM) = %LBN_SELCHANGE THEN
                  '  You can trap changes in selection here, if needed. Uncomment the following code to see a way of checking selected or not.
                  '  Can also be used in other place, like checking entire list  before exit, etc. Note, this one does not respond to space bar.
                  ln   = SendMessage(CBLPARAM, %LB_GETCURSEL  , 0 , 0)
                  lRes = SendMessage(CBLPARAM, %LB_GETITEMDATA, ln, 0)
                 'MSGBOX "Status: " + STR$(lRes) + STR$(ln)

                  FUNCTION = 0
                  EXIT FUNCTION

               END IF
            END SELECT

      CASE %WM_DESTROY
         '  Un-subclass the listbox on exit
         IF LBCProcess_XX THEN SetWindowLong GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST), %GWL_WNDPROC, LBCProcess_XX

      CASE %WM_DRAWITEM, %WM_MEASUREITEM     '  Pass these on to ProcessDialog_LBC
         IF CBWPARAM = %IDC_LB_CHECKLIST THEN
            ProcessDialog_LBC GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST), CBMSG, CBWPARAM, CBLPARAM
            EXIT FUNCTION
         END IF

   END SELECT

END FUNCTION


FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

   '  Derived from http://www.powerbasic.com/support/pbforums/showthread.php?t=23613&highlight=Listbox+Checkboxes

   DIM pt      AS POINTAPI
   DIM rc      AS RECT
   DIM i_LB    AS LONG
   DIM L_LB    AS LONG
   DIM hCtrl   AS LONG
   DIM lpdis   AS DRAWITEMSTRUCT PTR
   DIM zTxt    AS ASCIIZ * 64

   hCtrl = GetWindowLong(hWnd, %GWL_ID)

   SELECT CASE wMsg

      CASE %WM_DRAWITEM
         lpdis = lParam
         IF @lpdis.itemID = &HFFFFFFFF& THEN EXIT FUNCTION

         SELECT CASE @lpdis.itemAction

            CASE %ODA_DRAWENTIRE, %ODA_SELECT
               '  DRAW BACKGROUND
               FillRect @lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_MENU  )

              '   DRAW TEXT
               SetBkColor   @lpdis.hDC, GetSysColor(%COLOR_MENU  )               '  Set text Background
               SetTextColor @lpdis.hDC, GetSysColor(%COLOR_INFOTEXT)             '  Set text color
               SendMessage hWnd, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)        '  Get text
               TextOut @lpdis.hDC, 18, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)   '  Draw text

               '   DRAW INVERTED SELECTION
               IF (@lpdis.itemState AND %ODS_SELECTED) THEN                      '  if selected
                  rc.nLeft   = 16 : rc.nRight = @lpdis.rcItem.nRight             '  Set cordinates
                  rc.ntop    = @lpdis.rcItem.ntop
                  rc.nbottom = @lpdis.rcItem.nbottom
                  InvertRect @lpdis.hDC, rc                                      '  invert area around text only
               END IF

               '  DRAW CHECKBOX
               rc.nLeft   = 02 : rc.nRight = 15                                  '  Set cordinates
               rc.ntop    = @lpdis.rcItem.ntop + 2
               rc.nbottom = @lpdis.rcItem.nbottom - 1
               IF SendMessage(hWnd, %LB_GETITEMDATA, @lpdis.itemID, 0) THEN      '  checked or not? itemdata knows
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK OR %DFCS_CHECKED
               ELSE
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK
               END IF
               FUNCTION = -1
               EXIT FUNCTION

            CASE %ODA_FOCUS
               DrawFocusRect @lpdis.hDC, @lpdis.rcItem                           '  draw focus rectangle

         END SELECT

      CASE %WM_KEYDOWN
         IF wParam = %VK_SPACE THEN                                              '  Respond to space bar
            i_LB = SendMessage(hWnd, %LB_GETCURSEL, 0, 0)                        '  get selected
            L_LB = NOT SendMessage(hWnd, %LB_GETITEMDATA, i_LB, 0)               '  get toggled item data
            CALL SendMessage(hWnd, %LB_SETITEMDATA, i_LB, L_LB)                  '  set toggleded item data
            CALL SendMessage(hWnd, %LB_GETITEMRECT, i_LB, VARPTR(rc))            '  get sel. items rect
            InvalidateRect hWnd, rc, 0 : UpdateWindow hWnd                       '  update select item only
            FUNCTION = 0
            EXIT FUNCTION                                                        '  return zero
         END IF

      CASE %WM_LBUTTONDOWN
         IF wParam = %MK_LBUTTON  THEN                                           '  respond to mouse click
            pt.x = LOWRD(lParam) : pt.y = HIWRD(lParam)                          '  get cursor pos
            i_LB = SendMessage(hWnd, %LB_ITEMFROMPOINT, 0, MAKLNG(pt.x, pt.y))   '  get select item
            SendMessage hWnd, %LB_GETITEMRECT, i_LB, VARPTR(rc)                  '  get select items rect
            rc.nLeft   = 02
            rc.nRight  = 15                                                      '  checkbox cordinates
            IF PtInRect(rc, pt.x, pt.y) THEN                                     '  if in checkbox
               L_LB = NOT SendMessage(hWnd, %LB_GETITEMDATA, i_LB, 00)           '  get toggled item data
               SendMessage hWnd, %LB_SETITEMDATA, i_LB, L_LB                     '  set toggled item data
               InvalidateRect hWnd, rc, 00
               UpdateWindow hWnd                                                 '  update select item only
            END IF
         END IF

   END SELECT

   FUNCTION = CallWindowProc(LBCProcess_XX, hWnd, wMsg, wParam, lParam)    '  process other messages

END FUNCTION

'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG

   LOCAL lRslt AS LONG

   LOCAL hDlg AS DWORD

   DIALOG NEW hParent, "Checklist", 266, 222, 276, 171, %WS_POPUP OR %WS_BORDER _
      OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
      %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
      %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
   CONTROL ADD BUTTON, hDlg, %IDC_BT_TOGGLE, "Toggle", 5, 5, 55, 15
   CONTROL ADD LISTBOX, hDlg, %IDC_LB_CHECKLIST, , 5, 25, 265, 140, %WS_CHILD OR _
      %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR %WS_TABSTOP OR _
      %LBS_DISABLENOSCROLL OR %WS_VSCROLL OR %WS_VISIBLE, %WS_EX_CLIENTEDGE

   DIM hList   AS LONG
   CONTROL HANDLE hDlg, %IDC_LB_CHECKLIST TO hList          '  Subclass listbox
   LBCProcess_XX = SetWindowLong(hList, %GWL_WNDPROC, CODEPTR(ProcessDialog_LBC))

   DIALOG SHOW MODAL hDlg, CALL ShowCHECKLISTProc TO lRslt

   FUNCTION = lRslt
END FUNCTION
'--------------------------------------------------------------------------------


SUB ProcessDialog_LBC_Check_GET(hDlg AS LONG, hCtr_LB AS LONG)

   DIM i_LB    AS LONG
   DIM N_LB    AS LONG
   DIM L_LB    AS LONG

   DIM hWnd    AS LONG


   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB

   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_GETITEMDATA, i_LB, 00 TO L_LB      '  set toggled item data
      MSGBOX STR$(i_LB) + STR$(L_LB)
   NEXT i_LB

END SUB


SUB ProcessDialog_LBC_Check_ALL(hDlg AS LONG, hCtr_LB AS LONG, L_LB AS LONG)

   DIM i_LB    AS LONG
   DIM N_LB    AS LONG

   DIM hWnd    AS LONG

   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB

   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_SETITEMDATA, i_LB, L_LB      '  set toggled item data
      InvalidateRect hWnd, BYVAL %NULL, 00
      UpdateWindow hWnd
   NEXT i_LB

END SUB

Do anybody have an idea why ?

[Dean Schrage]

Derives from earlier source, includes rapid toggle.

#PBFORMS Created
'--------------------------------------------------------------------------------
' The first line in this file is a PBForms metastatement.
' It should ALWAYS be the first line of the file. Other
' PBForms metastatements are placed at the beginning and
' ending of blocks of code that should be edited using
' PBForms only. Do not edit or delete these
' metastatements or PBForms will not be able to reread
' the file correctly. See the PBForms documentation for
' more information.
' Beginning blocks begin like this: #PBForms Begin ...
' Ending blocks begin like this:    #PBForms End ...
' Other PBForms metastatements such as:
'     #PBForms Declarations
' are used to tell PBForms where to insert additional
' code. Feel free to make changes anywhere else in the file.
'--------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'--------------------------------------------------------------------------------
'   ** Includes **
'--------------------------------------------------------------------------------
#PBFORMS Begin Includes
#IF NOT %DEF(%WINAPI)
   #INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS End Includes
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Constants **
'--------------------------------------------------------------------------------
#PBFORMS Begin Constants
%IDD_CHECKLIST    = 101
%IDC_BT_TOGGLE    = 1001
%IDC_LB_CHECKLIST = 1002
#PBFORMS End Constants
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Declarations **
'--------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowCHECKLISTProc()
DECLARE FUNCTION SampleListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
   lCount AS LONG) AS LONG
DECLARE FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG
#PBFORMS Declarations
'--------------------------------------------------------------------------------

   GLOBAL LBCProcess_XX AS DWORD    '  for subclassing, to store original LB procedure address
   DECLARE FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

'--------------------------------------------------------------------------------
FUNCTION PBMAIN()
   ShowCHECKLIST %HWND_DESKTOP
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ShowCHECKLISTProc()

   DIM lRes          AS LONG
   DIM ln            AS LONG        '  return checkbox status
   DIM i_LB          AS LONG
   DIM N_LB          AS STATIC LONG    : N_LB = 20
   REDIM S_LB(N_LB)  AS STATIC STRING

   SELECT CASE CBMSG

      CASE %WM_INITDIALOG
         FOR i_LB = 01 TO N_LB
            S_LB(i_LB) = "Item " + STR$(i_LB)
            LISTBOX ADD CBHNDL, %IDC_LB_CHECKLIST, S_LB(i_LB)
         NEXT i_LB

      CASE %WM_CTLCOLORLISTBOX
         IF CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) OR CBLPARAM = GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST) THEN
            FUNCTION = GetSysColorBrush(%COLOR_MENU  )
           'FUNCTION = GetSysColorBrush(%COLOR_INFOBK)
         END IF

      CASE %WM_LBUTTONDBLCLK
         CALL ProcessDialog_LBC_Check_GET(CBHNDL, %IDC_LB_CHECKLIST)

      CASE %WM_COMMAND
         SELECT CASE CBCTL
            CASE %IDC_BT_TOGGLE
               DIM L_LB AS STATIC LONG
               L_LB = NOT L_LB
               CALL ProcessDialog_LBC_Check_ALL(CBHNDL, %IDC_LB_CHECKLIST, L_LB)

            CASE %IDC_LB_CHECKLIST
               IF HIWRD(CBWPARAM) = %LBN_SELCHANGE THEN
                  '  You can trap changes in selection here, if needed. Uncomment the following code to see a way of checking selected or not.
                  '  Can also be used in other place, like checking entire list  before exit, etc. Note, this one does not respond to space bar.
                  ln   = SendMessage(CBLPARAM, %LB_GETCURSEL  , 0 , 0)
                  lRes = SendMessage(CBLPARAM, %LB_GETITEMDATA, ln, 0)
                 'MSGBOX "Status: " + STR$(lRes) + STR$(ln)

                  FUNCTION = 0
                  EXIT FUNCTION

               END IF
            END SELECT

      CASE %WM_DESTROY
         '  Un-subclass the listbox on exit
         IF LBCProcess_XX THEN SetWindowLong GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST), %GWL_WNDPROC, LBCProcess_XX

      CASE %WM_DRAWITEM, %WM_MEASUREITEM     '  Pass these on to ProcessDialog_LBC
         IF CBWPARAM = %IDC_LB_CHECKLIST THEN
            ProcessDialog_LBC GetDlgItem(CBHNDL, %IDC_LB_CHECKLIST), CBMSG, CBWPARAM, CBLPARAM
            EXIT FUNCTION
         END IF

   END SELECT

END FUNCTION


FUNCTION ProcessDialog_LBC(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

   '  Derived from http://www.powerbasic.com/support/pbforums/showthread.php?t=23613&highlight=Listbox+Checkboxes

   DIM pt      AS POINTAPI
   DIM rc      AS RECT
   DIM i_LB    AS LONG
   DIM L_LB    AS LONG
   DIM hCtrl   AS LONG
   DIM lpdis   AS DRAWITEMSTRUCT PTR
   DIM zTxt    AS ASCIIZ * 64

   hCtrl = GetWindowLong(hWnd, %GWL_ID)

   SELECT CASE wMsg

      CASE %WM_DRAWITEM
         lpdis = lParam
         IF @lpdis.itemID = &HFFFFFFFF& THEN EXIT FUNCTION

         SELECT CASE @lpdis.itemAction

            CASE %ODA_DRAWENTIRE, %ODA_SELECT
               '  DRAW BACKGROUND
               FillRect @lpdis.hDC, @lpdis.rcItem, GetSysColorBrush(%COLOR_MENU  )

              '   DRAW TEXT
               SetBkColor   @lpdis.hDC, GetSysColor(%COLOR_MENU  )               '  Set text Background
               SetTextColor @lpdis.hDC, GetSysColor(%COLOR_INFOTEXT)             '  Set text color
               SendMessage hWnd, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)        '  Get text
               TextOut @lpdis.hDC, 18, @lpdis.rcItem.ntop + 2, zTxt, LEN(zTxt)   '  Draw text

               '   DRAW INVERTED SELECTION
               IF (@lpdis.itemState AND %ODS_SELECTED) THEN                      '  if selected
                  rc.nLeft   = 16 : rc.nRight = @lpdis.rcItem.nRight             '  Set cordinates
                  rc.ntop    = @lpdis.rcItem.ntop
                  rc.nbottom = @lpdis.rcItem.nbottom
                  InvertRect @lpdis.hDC, rc                                      '  invert area around text only
               END IF

               '  DRAW CHECKBOX
               rc.nLeft   = 02 : rc.nRight = 15                                  '  Set cordinates
               rc.ntop    = @lpdis.rcItem.ntop + 2
               rc.nbottom = @lpdis.rcItem.nbottom - 1
               IF SendMessage(hWnd, %LB_GETITEMDATA, @lpdis.itemID, 0) THEN      '  checked or not? itemdata knows
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK OR %DFCS_CHECKED
               ELSE
                  DrawFrameControl @lpdis.hDC, rc, %DFC_BUTTON, %DFCS_BUTTONCHECK
               END IF
               FUNCTION = -1
               EXIT FUNCTION

            CASE %ODA_FOCUS
               DrawFocusRect @lpdis.hDC, @lpdis.rcItem                           '  draw focus rectangle

         END SELECT

      CASE %WM_KEYDOWN
         IF wParam = %VK_SPACE THEN                                              '  Respond to space bar
            i_LB = SendMessage(hWnd, %LB_GETCURSEL, 0, 0)                        '  get selected
            L_LB = NOT SendMessage(hWnd, %LB_GETITEMDATA, i_LB, 0)               '  get toggled item data
            CALL SendMessage(hWnd, %LB_SETITEMDATA, i_LB, L_LB)                  '  set toggleded item data
            CALL SendMessage(hWnd, %LB_GETITEMRECT, i_LB, VARPTR(rc))            '  get sel. items rect
            InvalidateRect hWnd, rc, 0 : UpdateWindow hWnd                       '  update select item only
            FUNCTION = 0
            EXIT FUNCTION                                                        '  return zero
         END IF

      CASE %WM_LBUTTONDOWN
         IF wParam = %MK_LBUTTON  THEN                                           '  respond to mouse click
            pt.x = LOWRD(lParam) : pt.y = HIWRD(lParam)                          '  get cursor pos
            i_LB = SendMessage(hWnd, %LB_ITEMFROMPOINT, 0, MAKLNG(pt.x, pt.y))   '  get select item
            SendMessage hWnd, %LB_GETITEMRECT, i_LB, VARPTR(rc)                  '  get select items rect
            rc.nLeft   = 02
            rc.nRight  = 15                                                      '  checkbox cordinates
            IF PtInRect(rc, pt.x, pt.y) THEN                                     '  if in checkbox
               L_LB = NOT SendMessage(hWnd, %LB_GETITEMDATA, i_LB, 00)           '  get toggled item data
               SendMessage hWnd, %LB_SETITEMDATA, i_LB, L_LB                     '  set toggled item data
               InvalidateRect hWnd, rc, 00
               UpdateWindow hWnd                                                 '  update select item only
            END IF
         END IF

   END SELECT

   FUNCTION = CallWindowProc(LBCProcess_XX, hWnd, wMsg, wParam, lParam)    '  process other messages

END FUNCTION

'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
'   ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowCHECKLIST(BYVAL hParent AS DWORD) AS LONG

   LOCAL lRslt AS LONG
   
#PBFORMS Begin Dialog %IDD_CHECKLIST->->

   LOCAL hDlg AS DWORD

   DIALOG NEW hParent, "Checklist", 266, 222, 276, 171, %WS_POPUP OR %WS_BORDER _
      OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
      %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
      %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
      %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
   CONTROL ADD BUTTON, hDlg, %IDC_BT_TOGGLE, "Toggle", 5, 5, 55, 15
   CONTROL ADD LISTBOX, hDlg, %IDC_LB_CHECKLIST, , 5, 25, 265, 140, %WS_CHILD OR _
      %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR %WS_TABSTOP OR _
      %LBS_DISABLENOSCROLL OR %WS_VSCROLL OR %WS_VISIBLE, %WS_EX_CLIENTEDGE

#PBFORMS End Dialog

   DIM hList   AS LONG
   CONTROL HANDLE hDlg, %IDC_LB_CHECKLIST TO hList          '  Subclass listbox
   LBCProcess_XX = SetWindowLong(hList, %GWL_WNDPROC, CODEPTR(ProcessDialog_LBC))

   DIALOG SHOW MODAL hDlg, CALL ShowCHECKLISTProc TO lRslt

   FUNCTION = lRslt
END FUNCTION
'--------------------------------------------------------------------------------


SUB ProcessDialog_LBC_Check_GET(hDlg AS LONG, hCtr_LB AS LONG)

   DIM i_LB    AS LONG
   DIM N_LB    AS LONG
   DIM L_LB    AS LONG

   DIM hWnd    AS LONG


   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB

   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_GETITEMDATA, i_LB, 00 TO L_LB      '  set toggled item data
      MSGBOX STR$(i_LB) + STR$(L_LB)
   NEXT i_LB

END SUB


SUB ProcessDialog_LBC_Check_ALL(hDlg AS LONG, hCtr_LB AS LONG, L_LB AS LONG)

   DIM i_LB    AS LONG
   DIM N_LB    AS LONG

   DIM hWnd    AS LONG

   GetDlgItem hdlg, hCtr_LB TO hWnd
   SendMessage hWnd, %LB_GETCOUNT, 00, 00 TO N_LB

   FOR i_LB = 00 TO N_LB - 01
      SendMessage hWnd, %LB_SETITEMDATA, i_LB, L_LB      '  set toggled item data
      InvalidateRect hWnd, BYVAL %NULL, 00
      UpdateWindow hWnd
   NEXT i_LB

END SUB