Tweet
Derives from earlier source, includes rapid toggle.
Code:
#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
Comment