Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Bit Field Variable Attached To Check Boxes, And WM_CTLCOLORSTATIC

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Bit Field Variable Attached To Check Boxes, And WM_CTLCOLORSTATIC

    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
    Last edited by Fred Harris; 16 Mar 2008, 06:24 PM. Reason: Try to improve it a bit (and be sized right for XP)!
    Fred
    "fharris"+Chr$(64)+"evenlink"+Chr$(46)+"com"
Working...
X