Tweet
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.
[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