Below is a program that shows how to associate an array of check boxes with bits in a 32 bit integer. It also shows handling of WM_CTLCOLORSTATIC message.
Code:
#Compile Exe 'Demo app showing bit fields attached to check boxes. #Dim All 'The app has a distinct Forestry flavor and shows #Include "Win32api.inc" 'how the PA Bureau of Forestry tracks timber sales %IDC_CHECKBOX = 5000 'on the lands it administers. The check boxes on %IDC_TEXTBOX = 5100 'the Timber Dale Tracking Form are tied to a 32 bit %IDC_TESTNUMBER = 5200 'integer field in a database. Administrative personnel %IDC_BTNEXECUTE = 5300 'are able to pull up a specific timber sale and 'immediately view its status. Type WndEventArgs wParam As Long lParam As Long 'Amalgaate Window Procedure Parameters Into Type hWnd As Dword hInst As Dword End Type Declare Function FnPtr(wea As WndEventArgs) As Long Type MessageHandler 'This is a type containing two integers. The 1st integer wMessage As Long 'is a Windows message, and the 2nd integer is the address dwFnPtr As Dword 'of the procedure which will handle that message. An array End Type 'of this type is created to hold the messages this app will Global MsgHdlr() As MessageHandler 'respond to. Function strConvertSysDate(strSysDate As String) As String Dim strDt As String strDt=strSysDate Replace Any "-" With "/" In strDt Function = strDt End Function Function fnOutputProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long Select Case As Long wMsg Case %WM_PAINT Local strFld1 As String*8,strFld2 As String*8 'This procedure (the Window Procedure for the' Local hMainWindow,hFont,hTmp,dwNum As Dword 'Output Screen Class) paints the output display Local lpPaint As PAINTSTRUCT 'window when you click the button. It attempts Local szBuffer As Asciiz*16 'to format stuff reasonably, and illustrate various Local strText As String 'bit minipulation techniques using And masks, for Register i As Long 'example. Local hDC As Long hMainWindow=GetWindowLong(hWnd,0) Call GetWindowText(GetDlgItem(GetWindowLong(hWnd,0),%IDC_TESTNUMBER),szBuffer,16) dwNum=Val(szBuffer) hDC=BeginPaint(hWnd,lpPaint) hFont=CreateFont(16,0,0,0,%FW_BOLD,0,0,0,0,0,0,2,0,"Courier New") hTmp=SelectObject(hDC,hFont) strText="CheckBox(i) State True/False*2^i Abs(IsTrue(dwNum And 2^i))" Call TextOut(hDC,0,0,Byval Strptr(strText),Len(strText)) strText="========================================================================" Call TextOut(hDC,0,12,Byval Strptr(strText),Len(strText)) For i=0 To 21 strText="CheckBox(" & Trim$(Str$(i)) & ")=" If SendMessage(GetDlgItem(GetWindowLong(hWnd,0),i+%IDC_CHECKBOX),%BM_GETCHECK,0,0)=%BST_CHECKED Then strText=strText & "True" Call TextOut(hDC,0,24+16*i,Byval Strptr(strText),Len(strText)) 'Note that the handle of the main strText="1*2^" & Trim$(Str$(i)) & "=" '& Trim$(Str$(2^i)) 'program window was stored in the LSet strFld1=strText 'cbWndExtra bytes in the CreateWindow() RSet strFld2=Trim$(Str$(2^i)) 'call that created this window. That's strText=strFld1 & strFld2 'what the GetWindowLong() in the above Call TextOut(hDC,140,24+16*i,Byval Strptr(strText),Len(strText)) 'If is all about. GetDlgItem() can then Else 'be used to get data out of controls on strText=strText & "False" 'the main form. Note that this avoids Call TextOut(hDC,0,24+16*i,Byval Strptr(strText),Len(strText)) 'globals entirely. This app has no LSet strFld1="0*2^" & Trim$(Str$(i)) & "=" 'globals. RSet strFld2=Trim$(Str$(0*2^i)) strText=strFld1 & strFld2 Call TextOut(hDC,140,24+16*i,Byval Strptr(strText),Len(strText)) End If strText="Abs(IsTrue(" & Trim$(Str$(dwNum)) & " And 2^" & Trim$(Str$(i)) & "))=" & Trim$(Str$(Abs(IsTrue(dwNum And 2^i)))) Call TextOut(hDC,280,24+16*i,Byval Strptr(strText),Len(strText)) Next i Call DeleteObject(SelectObject(hDC,hTmp)) Call EndPaint(hWnd,lpPaint) fnOutputProc=0 Exit Function Case %WM_DESTROY EnableWindow(GetDlgItem(GetWindowLong(hWnd,0),%IDC_BTNEXECUTE),%TRUE) fnOutputProc=0 Exit Function End Select fnOutputProc=DefWindowProc(hWnd,wMsg,wParam,lParam) End Function Function fnWndProc_OnCreate(wea As WndEventArgs) As Long Local pCreateStruct As CREATESTRUCT Ptr Local hStatus,hCtrl,dwStyle As Dword Local strCaption() As String Local szClass As Asciiz *16 Local dwPtr As Dword Ptr Local wcx As WNDCLASSEX Local strText As String Register i As Long 'Register 'Output Screen' Class pCreateStruct=wea.lParam 'In WM_CREATE lParam Is [email protected] 'Pointer to CREATESTRUCT szClass="Output Screen" wcx.cbSize=SizeOf(wcx) wcx.style=%CS_HREDRAW Or %CS_VREDRAW wcx.lpfnWndProc=CodePtr(fnOutputProc) wcx.cbClsExtra=0 wcx.cbWndExtra=4 'Store Main Window Handle wcx.hInstance=Wea.hInst 'So As To Use GetDlgItem() wcx.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) 'For Retrieval of CheckBoxes wcx.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW) wcx.hbrBackground=GetStockObject(%WHITE_BRUSH) wcx.lpszMenuName=%NULL wcx.lpszClassName=VarPtr(szClass) Call RegisterClassEx(wcx) Redim strCaption(21) As String 'Captions For Check Boxes strCaption(0)= "Received Timber Sale Proposal" strCaption(1)= "Sent Sale Approval To District" strCaption(2)= "Received Timber Sale Data" strCaption(3)= "Processed Timber Sale" strCaption(4)= "Draft Prospectus Done" strCaption(5)= "Prospectus Mailed To Buyers" strCaption(6)= "Sale Awarded" strCaption(7)= "No Bid Sale" strCaption(8)= "Approved To Negotiate No-Bid" strCaption(9)= "Sent Contract To Buyer" strCaption(10)="Received Contract From Buyer" strCaption(11)="Sent Contract To Legal" strCaption(12)="Received Contract From Legal" strCaption(13)="Contract Executed" strCaption(14)="Sent Perf. Dep. To Comptroller." strCaption(15)="Sale Activated (1st Block Paid)" strCaption(16)="Received FMT-9 From District Forester" strCaption(17)="Sale Terminated" strCaption(18)="Request Comptroller For Perf. Dep." strCaption(19)="Returned Performance Deposit" strCaption(20)="Withheld Perf. Deposit." strCaption(21)="State Park Sale" dwPtr=GlobalAlloc(%GPTR,24) 'Allocate memory to store hBrushs for colored checkboxes Call SetWindowLong(wea.hWnd,0,dwPtr) 'Store memory location at offset 0 in cbWndExtra bytes dwStyle=%WS_CHILD Or %WS_VISIBLE Or %BS_NOTIFY Or %BS_AUTOCHECKBOX Or %BS_TEXT strText= _ "When The Program Starts Click The 'Display Bits' Button Near" & Chr$(13) & _ "The Bottom. This Will Popup An Output Window Where You Will" & Chr$(13) & _ "Get Visual Feedback From Your Check Box Clicking Activities." & Chr$(13) & _ "It Will Likely Provide High Order Entertainment Value For Anywhere" & Chr$(13) & _ "From Two To Four Minutes, Depending Of Course On How" & Chr$(13) & _ "Easily You Are Entertained!" MsgBox(strText) 'Create Group Box For Check Boxes hStatus= _ CreateWindowEx _ ( _ %WS_EX_WINDOWEDGE, _ "button", _ ] "Timber Sale Status", _ %WS_CHILD Or %WS_VISIBLE Or %BS_GROUPBOX, _ 5, _ 5, _ 390, _ (UBound(strCaption,1)+1)*26, _ wea.hWnd, _ 4000, _ wea.hInst, _ Byval 0 _ ) 'Create Check Boxes and Edit Boxes In Loop For i=0 To 21 'First Check Boxes hCtrl= _ CreateWindowEx _ ( _ 0, _ "button", _ Byval Strptr(strCaption(i)), _ dwStyle, _ 15, _ 25+i*25, _ 250, _ 22, _ wea.hWnd, _ i+%IDC_CHECKBOX, _ wea.hInst, _ Byval 0 _ ) 'Now Edit Controls hCtrl= _ CreateWindowEx _ ( _ %WS_EX_CLIENTEDGE, _ "edit", _ "", _ %WS_CHILD Or %WS_VISIBLE Or %WS_BORDER, _ 290, _ 25+i*25, _ 85, _ 22, _ wea.hWnd, _ i+%IDC_TEXTBOX, _ wea.hInst, _ Byval 0 _ ) Next i Erase strCaption 'Make Label hCtrl= _ CreateWindowEx _ ( _ 0, _ "static", _ "Amalgamated Value of Bits In Dword", _ %WS_CHILD Or %WS_VISIBLE, _ 10, _ 590, _ 250, _ 20, _ wea.hWnd, _ -1, _ wea.hInst, _ Byval 0 _ ) 'Now make edit control to display Amalgamated bits into Dword hCtrl= _ CreateWindowEx _ ( _ %WS_EX_CLIENTEDGE, _ "edit", _ "", _ %WS_CHILD Or %WS_VISIBLE Or %WS_BORDER, _ 65, _ 615, _ 110, _ 22, _ wea.hWnd, _ %IDC_TESTNUMBER, _ wea.hInst, _ Byval 0 _ ) 'Now make 'Execute' button hCtrl= _ CreateWindowEx _ ( _ 0, _ "button", _ "Display Bits", _ %WS_CHILD Or %WS_VISIBLE, _ 280, _ 590, _ 105, _ 50, _ wea.hWnd, _ %IDC_BTNEXECUTE, _ wea.hInst, _ Byval 0 _ ) fnWndProc_OnCreate=0 End Function Function fnWndProc_OnCtlColorStatic(wea As WndEventArgs) As Long Local dwPtr As Dword Ptr Local hBrush As Dword dwPtr=GetWindowLong(wea.hWnd,0) 'This is actually a little complicated. Call SetBkMode(Byval wea.wParam,%TRANSPARENT) 'Right before Windows paints a label Select Case As Long GetDlgCtrlID(wea.lParam) '(static control) contained within any Case %IDC_CHECKBOX 'Received Timber Sale Proposal 'complex control such as a checkbox, it If @dwPtr[0]=%NULL Then 'sends the parent of the control a hBrush=CreateSolidBrush(Byval &H0000FF00) 'WM_CTLCOLORSTATIC message. The wParam @dwPtr[0]=hBrush 'and lParam parameters associated with Else 'this message are especially interesting, [email protected][0] 'in that they allow the user of the End If 'control to change how Windows paints Case %IDC_CHECKBOX+1 'Sent Sale Approval To District 'the background of the control. The If @dwPtr[1]=%NULL Then 'wParam is the handle to the device hBrush=CreateSolidBrush(Byval &H0000FFFF) 'context and the lParam is the handle of @dwPtr[1]=hBrush 'the control. Note in the code at left Else 'the GetCtrlID(wea.lParam) is used in [email protected][1] 'the Select Case logic to determine which End If 'particular one of the 22 check boxes the Case %IDC_CHECKBOX+2 'Received Timber Sale Data 'message is being received for. The If @dwPtr[2]=%NULL Then 'application only needs to change the hBrush=CreateSolidBrush(Byval &H000080FF) 'color for six of the 22 check boxes. In @dwPtr[2]=hBrush 'the case of those for which the app does Else 'not change the color, the message is just [email protected][2] 'passed to DefWindowProc() for default End If 'processing. In that case the hDC will Case %IDC_CHECKBOX+6 'Sale Awarded 'be passed back to windows and the system If @dwPtr[3]=%NULL Then 'color will result. However, with the hBrush=CreateSolidBrush(Byval &H000000FF) 'other six a new Brush is created, and @dwPtr[3]=hBrush 'that brush is returned from the function. Else 'Note that the six new hBrushes are stored [email protected][3] 'using a pointer in the cbWndExtra bytes. End If 'Also note that the new hBrush is only Case %IDC_CHECKBOX+13 'Contract Executed 'created once and accessed whenever the If @dwPtr[4]=%NULL Then 'OS needs it. WM_CTLCOLORSTATIC messages hBrush=CreateSolidBrush(Byval &H000000FF) 'come whenever the control needs to @dwPtr[4]=hBrush 'redraw itself. At termination of the Else 'app these GDI objects are destroyed. h[email protected][4] End If Case %IDC_CHECKBOX+17 'Sale Terminated If @dwPtr[5]=%NULL Then hBrush=CreateSolidBrush(Byval &H0000FFFF) @dwPtr[5]=hBrush Else [email protected][5] End If Case Else Call DefWindowProc(wea.hWnd,%WM_CTLCOLORSTATIC,wea.wParam,wea.lParam) End Select fnWndProc_OnCtlColorStatic=hBrush End Function Sub CheckBox_OnClick(wea As WndEventArgs) Local szBuffer As Asciiz*16 Local dwNum As Dword If SendMessage(wea.lParam,%BM_GETCHECK,0,0)=%BST_CHECKED Then Call SetWindowText _ 'All this code does ( _ 'is put the date when GetDlgItem(wea.hWnd,Lowrd(wea.wParam)-%IDC_CHECKBOX+%IDC_TEXTBOX), _ 'you clicked the check strConvertSysDate(Date$) _ 'box in the adjacent ) 'text box. Call GetWindowText(GetDlgItem(wea.hWnd,%IDC_TESTNUMBER),szBuffer,16) dwNum=Val(szBuffer) 'This here code puts dwNum=dwNum Or 2^(Lowrd(wea.wParam)-%IDC_CHECKBOX) 'into a Dword the szBuffer=Str$(dwNum) 'number in the text box Call SetWindowText(GetDlgItem(wea.hWnd,%IDC_TESTNUMBER),szBuffer) 'at bottom. Then it or's Else 'into that number the Call SetWindowText _ 'zero based bit associated ( _ 'with the specific ck box. GetDlgItem(wea.hWnd,(Lowrd(wea.wParam)-%IDC_CHECKBOX+%IDC_TEXTBOX)), _ "" _ 'Note that Xor is used to ) 'toggle a bit out of the Call GetWindowText(GetDlgItem(wea.hWnd,%IDC_TESTNUMBER),szBuffer,16) 'number in the textbox if dwNum=Val(szBuffer) 'the checkbox is unchecked. dwNum=dwNum Xor 2^(Lowrd(wea.wParam)-%IDC_CHECKBOX) szBuffer=Str$(dwNum) Call SetWindowText(GetDlgItem(wea.hWnd,%IDC_TESTNUMBER),szBuffer) End If If GetWindowLong(wea.hWnd,4) Then InvalidateRect(GetWindowLong(wea.hWnd,4),Byval %NULL,%TRUE) End If End Sub Sub btnExecute_OnClick(wea As WndEventArgs) Register i As Long Local hOutput As Dword hOutput= _ 'This procedure executes when CreateWindowEx _ 'the Display button is pressed. ( _ 'It creates an instance of the 0, _ 'Output Screen Class and paints "Output Screen", _ 'info about the number in the "Bytes Set From Text Box Input", _ 'bottom textbox and the status %WS_OVERLAPPEDWINDOW Xor %WS_MAXIMIZEBOX, _ 'of the various check boxes. 725,200,520,415, _ 'Note that the hWnd of this 0, _ 'Main App window is stored in 0, _ 'the four cbWndExtra bytes GetModuleHandle(""), _ 'allocated down in Byval %NULL _ 'fnWndProc_OnCreate() for the ) 'Output Screen Class (in the Call SetWindowLong(hOutput,0,Wea.hWnd) 'SetWindowLong() call just at Call SetWindowLong(wea.hWnd,4,hOutput) 'left <<< Call ShowWindow(hOutput,%SW_SHOWNORMAL) EnableWindow(GetDlgItem(wea.hWnd,%IDC_BTNEXECUTE),%FALSE) End Sub Function fnWndProc_OnCommand(wea As WndEventArgs) As Long Select Case As Long Lowrd(wea.wParam) Case %IDC_CHECKBOX To %IDC_CHECKBOX+21 If Hiwrd(wea.wParam)=%BN_CLICKED Then Call CheckBox_OnClick(wea) End If Case %IDC_BTNEXECUTE If Hiwrd(wea.wParam)=%BN_CLICKED Then Call btnExecute_OnClick(wea) End If End Select fnWndProc_OnCommand=0 End Function Function fnWndProc_OnClose(wea As WndEventArgs) As Long Local dwPtr As Dword Ptr Local strBuffer As String Register i As Long dwPtr=GetWindowLong(wea.hWnd,0) strBuffer="DeleteObject(@dwPtr[i])" & Chr$(13) & "===============" & Chr$(13) For i=0 To 5 strBuffer=strBuffer & Space$(16) & Str$(DeleteObject(@dwPtr[i])) & Chr$(13) Next i MsgBox(strBuffer) MsgBox("1s Are Good Here!") MsgBox("But Here 0's Are What You Want!") MsgBox("GlobalFree(dwPtr)=" & Str$(GlobalFree(dwPtr)) & Chr$(13) & " 0=Good / 1=Bad") Call DestroyWindow(wea.hWnd) Call PostQuitMessage(0) fnWndProc_OnClose=0 End Function Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long Register i As Long For i=0 To 3 If wMsg=MsgHdlr(i).wMessage Then 'This construct routes processing Local wea As WndEventArgs 'to the correct message handler for Local iReturn As Long 'the specific message being received. wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam 'AttachMessageHandlers() is called Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn 'down in WinMain() and this latter fnWndProc=iReturn 'procedure (just below) associates a Exit Function 'message with the runtime address of End If 'the function within this app which Next i 'handles it. As can be seen just 'below, PowerBASIC's CodePtr() function fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam) 'is used. End Function Sub AttachMessageHandlers() ReDim MsgHdlr(3) As MessageHandler ' Associate Windows Message With Message Handlers MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate) MsgHdlr(1).wMessage=%WM_CTLCOLORSTATIC : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCtlColorStatic) MsgHdlr(2).wMessage=%WM_COMMAND : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnCommand) MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnClose) End Sub Function WinMain(ByVal hIns As Long,ByVal hPrev As Long,ByVal lpCL As Asciiz Ptr,ByVal iShow As Long) As Long Local szAppName As Asciiz * 16 Local wc As WndClassEx Local Msg As tagMsg Local hWnd As Dword szAppName="Bits And Pieces" : Call AttachMessageHandlers() wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0 wc.cbWndExtra=8 : wc.hInstance=hIns wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW) wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL wc.lpszClassName=VarPtr(szAppName) Call RegisterClassEx(wc) hWnd=CreateWindow(szAppName,szAppName,%WS_OVERLAPPEDWINDOW,200,100,430,680,0,0,hIns,ByVal 0) Call ShowWindow(hWnd,iShow) While GetMessage(Msg,%NULL,0,0) TranslateMessage Msg DispatchMessage Msg Wend Function=msg.wParam End Function