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