Fred's Tutorial #10: Building A Custom Control - A Simple Example

[Frederick J. Harris]

A number of years back I realized that custom controls would be an excellent way of modularizing or 'componentising' some aspect of GUI behavior.  I really didn't know how to go about it though until I found a tutorial on custom controls by Chris Boss.  I will shortly provide a link to this tutorial which I believe Chris still maintains.  While the code I am providing below on building a custom control bears little resemblance to Chris' original code, it was nonetheless inspired by Chris' work.  What I did was add some messaging functionality to Chris' idea.

The specific thing I wanted to learn how to do was create specialized data entry grids that would allow for the very rapid and efficient entry of large volumes of data.  In developing this rather simple minded example I am presenting to you below, I was able to figure out the underlying messaging architecture that would allow me to create my more advanced grid controls.  I am providing this code in the hope some of you might also find it useful.

The first program below – CustomControlClient.bas, contains four controls.  There are three buttons with labels of blue, green, and red.  The fourth control is a rather silly custom control that is nothing but a window painted some particular color.  When you click one of the three buttons the color printed on the button's label is painted in the custom control's window.  While its silly, it does show the underlying architecture of a custom control in simple enough detail to be reasonably easily understood.  Finally, when you click on the custom control, the control sends a message back to the host and a message box coded in the host displays all the 'state' information contained in the custom control.  I used PowerBASIC 9.0 for this project and Jose's Includes, but it should work with PowerBASIC's standard Includes too.

Finally, at some future date I intend to provide code showing how to turn this control into an ActiveX Control.  And I can state with a fair degree of accuracy when that will occur:  It will occur when I have finally figured out how to do it or someone shows me how to do it! 

CustomControlClient.bas

Code Select Expand


#Compile Exe              'This app hosts a simple custom control housed in dllCustomControlServer.dll.
#Dim All                  'This is a fairly simple control that does not even export any functions, and
#Include "Win32api.inc"   'all communication between the control and this app is through Windows messaging.
%IDC_BUTTON1              =1300           'Control ID For Blue' Button
%IDC_BUTTON2              =1305           'Control ID For Green' Button
%IDC_BUTTON3              =1310           'Control ID For Red' Button
%FORM1_CUSTOM1            =1315           'Control ID For Custom Control
%MY_CUSTOM_MESSAGE        =1500           'Custom User Defined Message For Custom Control
%MY_CUS_MSG_LBUTTON_DOWN  =1505           'and another
Global hDll As Dword      'When Microsoft created their suite of 'Common Controls' such as the.........


Type WndEventArgs         '...SysMonthCal control, Tab control, etc., they realized that more complicated 
  wParam As Long          'information needed to be passed between the host of the control and the control
  lParam As Long          'itself than could be handled by the wParam and lParam parameters to the Window
  hWnd   As Dword         'procedure that are such a basic part of the Windows messaging mechanism used by
  hInst  As Dword         'simpler controls such as edit boxes and listboxes.  What they did was create a
End Type                  'new WM_ message named WM_NOTIFY that the custom control would send to its host...


Type WindowColor          'Associated with this WM_NOTIFY message is a wParam and lParam just like with all
  lpnmh As NMHDR          'messages.  However, the lParam will hold a pointer to a large type/structure whose
  szColor As Asciiz*16    'fields are unique to whatever functionality the custom control exposes.  Since this
End Type                  'apps's custom control only manifests itself as a colored window, it only exposes...


Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
  Local pCreateStruct As CREATESTRUCT Ptr
  Local hButton As Dword    '...a simple type/structure with a field for window color, i.e., szColor (see type WindowColor
  Local dwStyle As Dword    'left above).  But the standard created by Microsoft is that the first member of this user
  Local hCus As Dword       'createdtype/structure should be a Microsoft defined structure named NMHDR (New Msg Handler).
  Register i As Long        'It looks like this...
 
  pCreateStruct=wea.lParam                'Type NMHDR   
  wea.hInst=@pCreateStruct.hInstance      '  hwndFrom  As Dword
  hDLL= _                                 '  idfrom    As Dword
  LoadLibrary _                           '  code      As Long
  ( _                                     'End Type                  continued below...
    "dllCustomControlServer.dll" _
  )
  if hDLL Then
     hButton=CreateWindowEx(0,"button","Blue",%WS_CHILD Or %WS_VISIBLE,8,10,80,25,wea.hWnd,%IDC_BUTTON1,wea.hInst,ByVal 0)
     hButton=CreateWindowEx(0,"button","Green",%WS_CHILD Or %WS_VISIBLE,8,40,80,25,wea.hWnd,%IDC_BUTTON2,wea.hInst,ByVal 0)
     hButton=CreateWindowEx(0,"button","Red",%WS_CHILD Or %WS_VISIBLE,8,70,80,25,wea.hWnd,%IDC_BUTTON3,wea.hInst,ByVal 0)
     dwStyle=%WS_CHILD Or %WS_VISIBLE Or %WS_THICKFRAME
     hCus= _
     CreateWindowEx _       '...Interupting for a moment our discussion of NMHDR, note that just left is the CreateWindow     
     ( _                    'call that instantiates our custom control located in the dll.  A custom control is created just
       %WS_EX_CLIENTEDGE, _ 'like any other control - through a CreateWindow() call.  Note that the 2nd parameter of the
       "Custom_Control", _  'CreateWindowEx() call is the registered class name of the custom control in the dll - here
       "", _                'Custom_Control.  I'll discuss that issue in the dll code.  But returning again to NMHDR, there
       dwStyle, _           'will be a window procedure within the dll for the custom control.  This window procedure will
       100, _               'receive Windows messages such as mouse movements, button clicks, etc., just like any window
       12, _                'procedure.  These windows messages received within the window procedure of the custom control
       325, _               'in the dll will be transferred/sent back to the host app in slightly modified form through this
       80, _                'NMHDR structure.  It might be instructive at this point to examine the WM_LBUTTONDOWN code in
       wea.hWnd, _          'ControlClassWndProc in the dllCustomControlServer.bas file to see what happens when a LButtonDown
       %FORM1_CUSTOM1, _    'occurs over the custom control.  First off you may note that a local variable of type WindowColor
       wea.hInst, _         'is declared at the top of the window procedure.  This type contains as its 1st member a NMHDR
       ByVal 0 _            'structure named lpnmh.  The 2nd member is an asciiz buffer to hold the color of the custom control.
     )                      'When a left button down occurs the NMHDR is filled out with the hWnd and CtrlID of the custom,
  Else                      'as well as a member we have not discussed yet named 'code'.  What goes here is a custom control
     MsgBox("Dll Load Failure!") 
     PostQuitMessage 0      'defined message that will inform the host of what exactly happened in the custom control.
     Function=-1            'In this case a WM_LBUTTONDOWN occurred.  A custom message equate is defined in both the dll and the 
     Exit Function          'host for this scenerio, e.g., %MY_CUS_MSG_LBUTTON_DOWN = 1505.  This gets assigned to the
  End If                    'wc.lpnmh.code member.  The next thing that happens is that the cbWndExtra bytes (0-3) of the
                     
  fnWndProc_OnCreate=0      'custom control's Window Class structure are queried for the RGB value stored there.  Four bytes
End Function                'of cbWndExtra storage were allocated in the Window Class structure for this purpose of storing...


'Event Handler For Click Of 'Blue' Button     '...the custom control's current color.  Select Case logic then translates the
Sub btnBlue_Click(wea As WndEventArgs)        'retrieved RGB value into an Asciiz string such as 'Red', 'Green', 'Blue', etc.
  Call SendMessage _                          'This string is then assigned to the wc.szColor member of the WindowColor type.
  ( _                                         'Then something critical happens.  This SendMessage() call is made...
    GetDlgItem(wea.hWnd,%FORM1_CUSTOM1), _    '
    %MY_CUSTOM_MESSAGE, _                     'SendMessage(GetParent(hWnd), %WM_NOTIFY, GetDlgCtrlID(hWnd), VarPtr(wc))
    RGB(0,0,255),0 _                          '
  )                                           'The 1st parameter will obtain the parent of the custom control which is the
End Sub                                       'client or this host app.  The 2nd parameter is the message to be sent to .....

                                             
'Event Handler For Click Of 'Green' Button    '...this app, and that would be the WM_NOTIFY message we have been discussing all
Sub btnGreen_Click(wea As WndEventArgs)       'along.  When this app receives a WM_NOTIFY message it will know that a message
  Call SendMessage _                          'from some custom control has arrived.  The 3rd parameter (wParam) of the
  ( _                                         'SendMessage() call is the control id of the particular custom control sending
    GetDlgItem(wea.hWnd,%FORM1_CUSTOM1), _    'the message.  The 4th parameter is the most important.  This would be the address
    %MY_CUSTOM_MESSAGE, _                     'of the wc WindowColor variable in the Window Procedure of the custom control.  And
    RGB(0,255,0), _                           'it is this variable that currently holds all the unique custom control 'state'
    0 _                                       'information of which the custom control wishes to make its host aware.  Note that
  )                                           'the Varptr(wc) was transferred back through this lParam parameter which is in
End Sub                                       'keeping with Windows typical use of this variable which is after all ultimately


'Event Handler For Click Of 'Red' Button      '...defined as a pointer variable in various windows header files.  So that explains
Sub btnRed_Click(wea As WndEventArgs)         'what happens in the dll when you click the mouse button over the custom control.
  Call SendMessage _                          'What needs to be explained here now in the host app is what happens when the buttons
  ( _                                         'just to the left of the custom control are clicked, and how the WM_NOTIFY handler
    GetDlgItem(wea.hWnd,%FORM1_CUSTOM1), _    'here works.  We'll start with the former being as the button click handlers are
    %MY_CUSTOM_MESSAGE, _                     'just to the left of these words you are reading.  First realize that the three
    RGB(255,0,0), _                           'buttons aren't part of the custom control.  They are located within this app and
    0 _                                       'are children of this app's main form.  When one of them is clicked this main form's
  )                                           'Window Procedure receives its typical WM_COMMAND message and logic then routes
End Sub                                       'program execution to one of these three button message handlers just to the left.


'Event Handler For %WM_COMMAND Messages       'What then happens is another SendMessage() Api call but this time the message is
Function fnWndProc_OnCommand(wea As WndEventArgs) As Long  'being sent to the custom control.  And the message being sent is
  Select Case LoWrd(wea.wParam)               'another custom control defined message - not a standard windows message. The
    Case %IDC_BUTTON1                         'message is defined both here and in the dll as follows - %MY_CUSTOM_MESSAGE=1500.
      Call btnBlue_Click(wea)                 'The third parameter (wParam) of the SendMessage() call is the RGB value that the
    Case %IDC_BUTTON2                         'host (this app) wants the custom control to draw itself, i.e., blue, green, or
      Call btnGreen_Click(wea)                'red.  Referring back to the Window Procedure within the dll in
    Case %IDC_BUTTON3                         'dllCustomControlServer.bas, you'll note a case - Case %MY_CUSTOM_MESSAGE - and
      Call btnRed_Click(wea)                  'this SendMessage() call from here will be 'picked up' there.  What then happens
  End Select                                  'is the RGB value placed here in the host in the wParam of the SendMessage() call

  fnWndProc_OnCommand=0                       'is stored there in the custom control in its previously allocated cbWndExtra
End Function                                  'bytes.  Then an InvalidateRect() call is finally made and this forces a WM_PAINT...


Function fnWndProc_OnNotify(wea As WndEventArgs) As Long '..within the custom control where the RGB value is retrieved from
  Local wc As WindowColor Ptr                            'the cbWndExtra bytes, a colored brush of the desired color created,
                                                         
  wc=wea.lParam                                          'and the window finally painted the desired color.  Well, that was a 
  Select Case As Long @wc.lpnmh.idFrom                   'mouthful but it brings us to fnWndProc_OnNotify() just to the left. 
    Case %FORM1_CUSTOM1                                  'That worked out pretty well I'd say!  That over there to the left
      Select Case As Long @wc.lpnmh.code                 'looks like a complicated mess of Select Case logic, doesn't it?  Well,
        Case %MY_CUS_MSG_LBUTTON_DOWN                    'its not all that complicated.  In fact, if you would remove every
          MsgBox _                                       'remnant of the select case statements and just leave the MsgBox() the           
          ( _                                            'program would still work.  What the Select Case logic does is determine             
            "wParam  = " & Str$(wea.wParam) & Chr$(13) & Chr$(10) & _                     'the specific custom control ID the
            "@wc.lpnmh.hwndFrom = " & Str$(@wc.lpnmh.hwndFrom) & Chr$(13) & Chr$(10) & _  'WM_NOTIFY is coming from, and the
            "@wc.lpnmh.idFrom = " & Str$(@wc.lpnmh.idFrom) & Chr$(13) & Chr$(10) & _      'particular custom message that has
            "@wc.lpnmh.code = " & Str$(@wc.lpnmh.code) & Chr$(13) & Chr$(10) & _          'just arrived.  In this unique case
            "@wc.szColor = " & @wc.szColor _             'we only have one instance of the custom control on the main form, and
          )                                              'that particular custom control only generates one message, but in
      End Select                                         'general custom controls should be designed so that any number of them
  End Select                                             'can be instantiated on a form/dialog, and many custom controls generate
 
  fnWndProc_OnNotify=0                                   'many different messages.  Think of a grid for example.  A grid might
End Function                                             'generate a message when a char key is pressed, when a cursor motion...


'Event Handler For %WM_CLOSE Message                     '...key is pressed, a button clicked, etc.  That's why in general Select
Function fnWndProc_OnClose(wea As WndEventArgs) As Long  'Case logic will be used.  Note also the variable declaration.  There is 
  Call FreeLibrary(hDll)                                 'only one - 'Local wc As WindowColor Ptr'  Don't forget that when the
  Call PostQuitMessage(0)                                'custom control SendMessag()'ed us the %MY_CUS_MSG_LBUTTON_DOWN message,
 
  fnWndProc_OnClose=0                                    'the lParam parameter was loaded with a pointer to a WindowColor Type,
End Function                                             'i.e., Varptr(wc).  That is why pointer notation is being used to....


Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) Export As Long
  Local wea As WndEventArgs                              '...dereference the pointer variable.  Finally note how the message box

  Select Case wMsg                                       'faithfully reports to us here in the host app the 'state' of the variables 
    Case %WM_CREATE                                      'in the custom control. 
      wea.wParam=wParam:wea.lParam=lParam:wea.hWnd=hWnd
      fnWndProc=fnWndProc_OnCreate(wea)                  '
      Exit Function
    Case %WM_COMMAND
      wea.wParam=wParam:wea.lParam=lParam:wea.hWnd=hWnd
      fnWndProc=fnWndProc_OnCommand(wea)
      Exit Function
    Case %WM_NOTIFY
      wea.wParam=wParam:wea.lParam=lParam:wea.hWnd=hWnd
      fnWndProc=fnWndProc_OnNotify(wea)
      Exit Function
    Case %WM_CLOSE
      wea.wParam=wParam:wea.lParam=lParam:wea.hWnd=hWnd
      fnWndProc=fnWndProc_OnClose(wea)
      Exit Function
  End Select

  fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function


Function blnAppInitialize(hIns As Long,szClassName As Asciiz) As Dword
  Local szAppName As Asciiz*16
  Local wcl As WndClassEx

  wcl.cbSize=SizeOf(wcl)
  wcl.style=%CS_HREDRAW Or %CS_VREDRAW
  wcl.lpfnWndProc=CodePtr(fnWndProc)
  wcl.cbClsExtra=0
  wcl.cbWndExtra=0
  wcl.hInstance=hIns
  wcl.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION)
  wcl.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
  wcl.hbrBackground=%COLOR_BTNFACE+1
  wcl.lpszMenuName=%NULL
  wcl.lpszClassName=VarPtr(szClassName)
  wcl.hIconSm=LoadIcon(hIns,ByVal %IDI_APPLICATION)
  If IsFalse(RegisterClassEx(wcl)) Then
     blnAppInitialize=%FALSE
     Exit Function
  End If

  Function=%TRUE
End Function


Function WinMain(ByVal hIns As Long, ByVal hPrevIns As Long,ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
  Local dwStyle,hMainWnd As Dword
  Local szAppName As Asciiz*32
  Local Msg As tagMsg

  szAppName="Custom Control Test"
  If blnAppInitialize(hIns,szAppName) Then    'Register App Class In blnAppInitialize()
     dwStyle=%WS_OVERLAPPEDWINDOW Xor %WS_MAXIMIZEBOX
     hMainWnd=CreateWindowEx(0,szAppName,szAppName,dwStyle,200,100,440,140,%HWND_DESKTOP,0,hIns,ByVal 0)
     Call ShowWindow(hMainWnd,iShow)
     Call UpdateWindow(hMainWnd)
     While GetMessage(Msg,%NULL,0,0)
       TranslateMessage Msg
       DispatchMessage Msg
     Wend
   End If

  Function=msg.wParam
End Function


And here is the code for dllCustomControlServer.bas that needs to be compiled into a dll that is used by CustomControlClient.exe

Code Select Expand


#Compile Dll "dllCustomControlServer.dll"    'Here is the code for te custom control contained in dllCustomControlServer.dll.
#Dim All                                     'I'd recommend you not use anything but local variables in the custom control
#Include "win32api.inc"                      'code so that multiple instances of the control can be created.  Otherwise,
%MY_CUSTOM_MESSAGE        =1500              'you'll likely end up with one control's memory messing up another's.
%MY_CUS_MSG_LBUTTON_DOWN  =1505


Type WindowColor                  'A pointer to a variable of this type will be sent to the parent or container window
  lpnmh As NMHDR                  'when a %WM_LBUTTONDOWN message is intercepted by the custom control.  Just for the
  szColor As Asciiz*16            'purpose of exposition, the cbWndExtra bytes will be interogated by a Call To
End Type                          'GetWindowLong() to obtain the RGB color stored there.  This will be sent to Parent.


'Window Procedure for the custom control.
Function ControlClassWndProc(ByVal hWnd As Long,ByVal Msg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local hDC,hNewBrush As Dword
  Local wc As WindowColor
  Local ps As PAINTSTRUCT

  Select Case Msg
    Case %WM_CREATE
      Call SetWindowLong(hWnd,0,RGB(255,255,0))   'Set default start up color to yellow and store RGB value
      Function=0                                  'of yellow in bytes 0 - 3 of allocated cbWndExtra bytes.
      Exit Function
    Case %WM_PAINT                                'When the custom control's window becomes invalid for
      hDC=BeginPaint(hWnd,ps)                     'whatever reason a WM_PAINT will be received and this code
      hNewBrush=CreateSolidBrush(GetWindowLong(hWnd,0))            'will run.  Note that a Brush will be
      'hNewBrush=CreateHatchBrush(%HS_CROSS,GetWindowLong(hWnd,0)) 'created of the color retrieved from
      Call FillRect(hDC,ps.rcPaint,hNewBrush)                      'the controls cbWndExtra bytes.  That is...
      Call DrawText(hDC, "Click Me!",-1,ps.rcPaint,%DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER)
      Call DeleteObject(hNewBrush)                'what the GetWindowLong(hWnd,0) is doing, i.e., retrieving
      Call EndPaint(hWnd,ps)                      'the RGB value stored in cbWndExtra bytes.
      Function=0
      Exit Function
    Case %WM_LBUTTONDOWN                          'If the particular custom control receives a left button
      wc.lpnmh.hwndFrom=hWnd                      'down message a WindowColor variable is filled out with
      wc.lpnmh.idFrom=GetDlgCtrlID(hWnd)          'such items of information as the control's hWnd, its
      wc.lpnmh.code=%MY_CUS_MSG_LBUTTON_DOWN      'Ctrl ID, and the present color of the control retrieved
      Select Case GetWindowLong(hWnd,0)           'from the cbWndExtra bytes.  Also, the wc.lpnmh.code
        Case RGB(255,0,0)   'red                  'member is set to %MY_CUS_MSG_LBUTTONDOWN to let the
          wc.szColor="Red"                        'host know what happened in the custom control.  Finally,
        Case RGB(0,255,0)   'green                'a pointer to the WindowColor type/struct is SendMessage()'ed
          wc.szColor="Green"                      'back to the host.  The message that the host will actually
        Case RGB(255,255,0) 'yellow               'receive is WM_NOTIFY.  The host will then dereference and
          wc.szColor="Yellow"                     'tear apart the WindowColor type to get at the sent data.
        Case RGB(0,0,255)   'blue
          wc.szColor="Blue"
      End Select
      Call SendMessage(GetParent(hWnd),%WM_NOTIFY,GetDlgCtrlID(hWnd),VarPtr(wc))  'Send info back to parent.
      Function=0
      Exit Function
    Case %MY_CUSTOM_MESSAGE                       'This is the message the host sends to the custom control
      Call SetWindowLong(hWnd,0,wParam)           'to let it know it wants it to do something, i.e., paint
      Call InvalidateRect(hWnd,ByVal %NULL,%TRUE) 'its window some particular color.  The host sends an RGB
      Function=0                                  'value in here through the wParam of the message, and here
      Exit Function                               'that wParam (containing an RGB value) is stored immediately
    Case %WM_SIZE                                 'in the cbWndExtra bytes.  Then an InvalidateRect() call
      Call InvalidateRect(hWnd,ByVal %NULL,%TRUE) 'forces a WM_PAINT where the RGB value is retrieved and
      Function=0                                  'the window painted.
      Exit Function
  End Select

  Function=DefWindowProc(hWnd,Msg,wParam,lParam)
End Function


Function RegisterControlClass() As Word                             'Many knowledgeable folks state that a custom control
  Local windowclass As WndClassEx                                   'should export some kind of Initialize() function the
  Local szClassName As Asciiz*16                                    'calling of which by the host app will cause the control's
                                                                    'class to be registered by a function such as directly
  szClassName="Custom_Control"                                      'at left.  At the risk of being savaged by such
  windowclass.cbSize=SizeOf(windowclass)                            'knowledgeable folks I have not done that here.  When
  windowclass.style=%CS_HREDRAW Or %CS_GLOBALCLASS Or %CS_DBLCLKS   'a dll is loaded its DllMain function is called with the
  windowclass.lpfnWndProc=CodePtr(ControlClassWndProc)              'fwdReason parameter set to DLL_PROCESS_ATTACH.  I use
  windowclass.cbClsExtra=0                                          'this message to register the custom control's class.
  windowclass.cbWndExtra=4  'Four extra bytes to store RGB color.   'The Windows documentation states that problems in
  windowclass.hInstance=GetModuleHandle(ByVal %NULL)                'dll load order can in some situations occur if GDI or
  windowclass.hIcon=%NULL                                           'user functions are called during a dll's DLL_PROCESS_ATTACH
  windowclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)            'message.  Kernel functions are OK but GDI functions can
  windowclass.hbrBackground=GetStockObject(%WHITE_BRUSH)            'be problematic according to the docs.  RegisterClassEx()
  windowclass.lpszMenuName=%NULL                                    'is a user32 function that returns an ATOM (Atoms are in
  windowclass.lpszClassName=VarPtr(szClassName)                     'kernel), and I have never had problems with this.
  windowclass.hIconSm=%NULL                                         'However, if it causes you any concern simply Export

  Function=RegisterClassEx(windowclass)                             'RegisterControlClass() and call it from WinMain()
End Function                                                        'or WM_CREATE.  In that case it wouldn't be necessary...


Function DllMain(ByVal hInstance As Long,ByVal fwdReason As Long,ByVal lpvReserved As Long) As Long
  If fwdReason=%DLL_PROCESS_ATTACH Then
     If RegisterControlClass()=%FALSE Then                          '...to LoadLibrary() the Dll, as implicit loading through
        Function=0                                                  'the Declare would be performed by PowerBASIC.
        Exit Function
     End If
  End If

  DllMain=1
End Function


[Dominic Mitchell]

Finally, at some future date I intend to provide code showing how to turn this control into an ActiveX Control.  And I can state with a fair degree of accuracy when that will occur:  It will occur when I have finally figured out how to do it or someone shows me how to do it!

Not difficult once the basic framework is in place. The basic framework involves a fair bit of coding.  By basic framework I mean the various interfaces that have to be supported, the registration code and type library file.
Unfortunately, I am too busy with Phoenix 3.0 right now to put together a sample.

[Frederick J. Harris]

Hi Dominic!

    You would probably be doing me a favor by not posting it because I'm the sort that enjoys figuring things out for myself.  However, if you were to post something like that, it would be an awful temptation not to peek!  I'm at the point of studying about 15 or so interfaces that most ActiveX controls implement, and wondering how they all fit together.  Working in raw C++ I've written quite a few different non-graphical COM components so far in my endeavors, some even with events, but I'm not sure how to put it all together with a visual control.  What I've finally decided to do is take the long but sure way and finally teach myself MFC and ATL (the former of which I've alwats despised and the latter never really looked at but seems somewhat promising) , then reverse engineer all that crappy wizard generated code to see what makes the things tick.  That has worked for me before in other endeavors. 

     Glad to hear you are working hard on Phoenix.  I've visited your site a few times and find your work interesting.  It looks like a nice product I wouldn't mind working with.  If I recall you have a trial download too. 

Fred

[Frederick J. Harris]

     For those who may be struggling with the structure or flow of program execution of SDK style Windows programs, this program starts in WinMain() near the bottom of CustomControlClient.bas.  After the main program's class is registered there is a call to CreateWindowEx() to create an instance of the main program's class - which actually comprises the creation of the main program's window...

Code Select Expand


hMainWnd=CreateWindowEx(0,szAppName,szAppName,dwStyle,200,100,440,140,%HWND_DESKTOP,0,hIns,ByVal 0)


     Nearly instantly thereafter the function fnWndProc_OnCreate() near the top of the source file will be called.  And near the top of that function is a LoadLibrary() call to load the dll containing the custom control....

Code Select Expand


     hDLL=LoadLibrary("dllCustomControlServer.dll")


     This will cause Windows to attempt to load and/or map the dll into the main process's address space.  If the load succeeds a non-zero LoadLibrary() return will occur, and the app tests for this, and exits gracefully if a failure (zero) occurs.

     When the LoadLibrary() occurs in fnWndProc_OnCreate(), a DLL_PROCESS_ATTACH message is sent to the loaded dll.  When that occurs within the dll there is an immediate call to RegisterControlClass(), which is a function within the dll that  registers the "Custom_Control" class.  If registration fails a zero is returned to the main program's fnWndProc_OnCreate() function as described above and the program ends.  If the registration of "Custom_Control" succeeds within the dll then it becomes possible within the main program to create instances of the custom control. This indeed happens further down in fnWndProc_OnCreate() where this call is made...

Code Select Expand


hCus=CreateWindowEx _
( _
%WS_EX_CLIENTEDGE,"Custom_Control","",dwStyle,100,12,325,80,wea.hWnd,%FORM1_CUSTOM1,wea.hInst,ByVal 0 _
)


     This CreateWindowEx() call will create an instance of the custom control on the form.  It should show up initially as a yellow rectangle within a raised or edged frame.  At this point the only possible inputs to the program are mouse clicks to any of the three buttons that are part of the main form, or a click on the custom control.

     As time permits I'll add some features to this control in terms of possibly an exported function interface, and a styles interface.

[Frederick J. Harris]

Since I've been referring to this custom control demo in the work I'm doing at this time creating a visual COM control out of this custom control, I thought I'd update it to show how a Visual Basic 6 client would use this control.  Actually, it can't.  To make the control usable in Visual Basic I had to export an Initialize() function and a function to return a WindowColor structure to the VB host instead of a pointer to a WindowColor structure.  First I'll post the revised custom controll dll code, then a Visual Basic 6 host.

Code Select Expand


'PowerBASIC 9 Dll Code
#Compile Dll "dllCustomControlServer.dll"    'Here is the code for the custom control contained in dllCustomControlServer.dll.
#Dim All                                     'I'd recommend you not use anything but local variables in the custom control
#Include "win32api.inc"                      'code so that multiple instances of the control can be created.  Otherwise,
%MY_CUSTOM_MESSAGE        =1500              'you'll likely end up with one control's memory messing up another's.
%MY_CUS_MSG_LBUTTON_DOWN  =1505


Type WindowColor                  'A pointer to a variable of this type will be sent to the parent or container window
  lpnmh As NMHDR                  'when a %WM_LBUTTONDOWN message is intercepted by the custom control.  Just for the
  szColor As Asciiz*16            'purpose of exposition, the cbWndExtra bytes will be interogated by a Call To
End Type                          'GetWindowLong() to obtain the RGB color stored there.  This will be sent to Parent.


Sub ccCrackPointer Alias "ccCrackPointer" (Byval lParam As Long, Byref wc As WindowColor) Export
  Local ptrWC As WindowColor Ptr

  ptrWC=lParam                                 'I did all this because Visual Basic doesn't handle pointers too well
  wc.lpnmh.hwndFrom=@ptrWC.lpnmh.hwndFrom      'or at all really as far as I know.  So when that pointer to a WindowColor
  wc.lpnmh.idFrom=@ptrWC.lpnmh.idFrom          'type is received in a WM_NOTIFY message in the Window Procedure in
  wc.lpnmh.code=@ptrWC.lpnmh.code              'Visual Basic, I send it back here to be re-processed and have the data
  wc.szColor=@ptrWC.szColor                    'sent back in a regular Type so VB can deal with it.  Maybe you can come
End Sub                                        'a better idea but this is all I could think of doing.


Function blnInitialize Alias "blnInitialize" () Export As Long
  Function=RegisterControlClass()
End Function


'Window Procedure for the custom control.
Function ControlClassWndProc(ByVal hWnd As Long,ByVal Msg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
  Local hDC,hNewBrush As Dword
  Local wc As WindowColor
  Local ps As PAINTSTRUCT

  Select Case Msg
    Case %WM_CREATE
      Call SetWindowLong(hWnd,0,RGB(255,255,0))   'Set default start up color to yellow and store RGB value
      Function=0                                  'of yellow in bytes 0 - 3 of allocated cbWndExtra bytes.
      Exit Function
    Case %WM_PAINT                                'When the custom control's window becomes invalid for
      hDC=BeginPaint(hWnd,ps)                     'whatever reason a WM_PAINT will be received and this code
      hNewBrush=CreateSolidBrush(GetWindowLong(hWnd,0))            'will run.  Note that a Brush will be
      'hNewBrush=CreateHatchBrush(%HS_CROSS,GetWindowLong(hWnd,0)) 'created of the color retrieved from
      Call FillRect(hDC,ps.rcPaint,hNewBrush)                      'the controls cbWndExtra bytes.  That is...
      Call DrawText(hDC, "Click Me!",-1,ps.rcPaint,%DT_SINGLELINE Or %DT_CENTER Or %DT_VCENTER)
      Call DeleteObject(hNewBrush)                'what the GetWindowLong(hWnd,0) is doing, i.e., retrieving
      Call EndPaint(hWnd,ps)                      'the RGB value stored in cbWndExtra bytes.
      Function=0
      Exit Function
    Case %WM_LBUTTONDOWN                          'If the particular custom control receives a left button
      wc.lpnmh.hwndFrom=hWnd                      'down message a WindowColor variable is filled out with
      wc.lpnmh.idFrom=GetDlgCtrlID(hWnd)          'such items of information as the control's hWnd, its
      wc.lpnmh.code=%MY_CUS_MSG_LBUTTON_DOWN      'Ctrl ID, and the present color of the control retrieved
      Select Case GetWindowLong(hWnd,0)           'from the cbWndExtra bytes.  Also, the wc.lpnmh.code
        Case RGB(255,0,0)   'red                  'member is set to %MY_CUS_MSG_LBUTTONDOWN to let the
          wc.szColor="Red"                        'host know what happened in the custom control.  Finally,
        Case RGB(0,255,0)   'green                'a pointer to the WindowColor type/struct is SendMessage()'ed
          wc.szColor="Green"                      'back to the host.  The message that the host will actually
        Case RGB(255,255,0) 'yellow               'receive is WM_NOTIFY.  The host will then dereference and
          wc.szColor="Yellow"                     'tear apart the WindowColor type to get at the sent data.
        Case RGB(0,0,255)   'blue
          wc.szColor="Blue"
      End Select
      Call SendMessage(GetParent(hWnd),%WM_NOTIFY,GetDlgCtrlID(hWnd),VarPtr(wc))  'Send info back to parent.
      Function=0
      Exit Function
    Case %MY_CUSTOM_MESSAGE                       'This is the message the host sends to the custom control
      Call SetWindowLong(hWnd,0,wParam)           'to let it know it wants it to do something, i.e., paint
      Call InvalidateRect(hWnd,ByVal %NULL,%TRUE) 'its window some particular color.  The host sends an RGB
      Function=0                                  'value in here through the wParam of the message, and here
      Exit Function                               'that wParam (containing an RGB value) is stored immediately
    Case %WM_SIZE                                 'in the cbWndExtra bytes.  Then an InvalidateRect() call
      Call InvalidateRect(hWnd,ByVal %NULL,%TRUE) 'forces a WM_PAINT where the RGB value is retrieved and
      Function=0                                  'the window painted.
      Exit Function
  End Select

  Function=DefWindowProc(hWnd,Msg,wParam,lParam)
End Function


Function RegisterControlClass() As Word                             'Many knowledgeable folks state that a custom control
  Local windowclass As WndClassEx                                   'should export some kind of Initialize() function the
  Local szClassName As Asciiz*16                                    'calling of which by the host app will cause the control's
                                                                    'class to be registered by a function such as directly
  szClassName="Custom_Control"                                      'at left.  At the risk of being savaged by such
  windowclass.cbSize=SizeOf(windowclass)                            'knowledgeable folks I have not done that here.  When
  windowclass.style=%CS_HREDRAW Or %CS_GLOBALCLASS Or %CS_DBLCLKS   'a dll is loaded its DllMain function is called with the
  windowclass.lpfnWndProc=CodePtr(ControlClassWndProc)              'fwdReason parameter set to DLL_PROCESS_ATTACH.  I use
  windowclass.cbClsExtra=0                                          'this message to register the custom control's class.
  windowclass.cbWndExtra=4  'Four extra bytes to store RGB color.   'The Windows documentation states that problems in
  windowclass.hInstance=GetModuleHandle(ByVal %NULL)                'dll load order can in some situations occur if GDI or
  windowclass.hIcon=%NULL                                           'user functions are called during a dll's DLL_PROCESS_ATTACH
  windowclass.hCursor=LoadCursor(%NULL,ByVal %IDC_ARROW)            'message.  Kernel functions are OK but GDI functions can
  windowclass.hbrBackground=GetStockObject(%WHITE_BRUSH)            'be problematic according to the docs.  RegisterClassEx()
  windowclass.lpszMenuName=%NULL                                    'is a user32 function that returns an ATOM (Atoms are in
  windowclass.lpszClassName=VarPtr(szClassName)                     'kernel), and I have never had problems with this.
  windowclass.hIconSm=%NULL                                         'However, if it causes you any concern simply Export

  Function=RegisterClassEx(windowclass)                             'RegisterControlClass() and call it from WinMain()
End Function                                                        'or WM_CREATE.  In that case it wouldn't be necessary...


Function DllMain(ByVal hInstance As Long,ByVal fwdReason As Long,ByVal lpvReserved As Long) As Long
  Select Case As Long fwdReason
    Case %DLL_PROCESS_ATTACH
      'Called When Dll Is Loaded.
    Case %DLL_PROCESS_DETACH
      'Called When Dll Is Unloaded.
  End Select

  DllMain=1
End Function


Now here are the files for a Visual Basic 6 Project that will produce the same exact program as the PowerBASIC host.  You might find it interesting to note that you can put Window Procedures, CreateWindow(), SendMessage() calls, so on and so forth, in Visual Basic 6 programs.  First modCusCtrl.bas

Code Select Expand


'This is VB6 Code!
Attribute VB_Name = "modCusCtrl"
Type NMHDR
    hwndFrom        As Long
    idfrom          As Long
    code            As Long
End Type

Type WindowColor
  lpnmh             As NMHDR
  strColor          As String * 16
End Type

Public Const WM_NOTIFY = &H4E
Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const MY_CUSTOM_MESSAGE = 1500
Public Const MY_CUS_MSG_LBUTTON_DOWN = 1505
Public Const MY_CUSTOM_CONTROL = 2000
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLib As Long) As Long
Public Declare Sub ccCrackPointer Lib "dllCustomControlServer" (ByVal lParam As Long, ByRef wc As WindowColor)
Public Declare Function blnInitialize Lib "dllCustomControlServer" () As Long
Public hDll As Long
Public hCus As Long

Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
( _
  ByVal dwExStyle As Long, _
  ByVal lpClassName As String, _
  ByVal lpWindowName As String, _
  ByVal dwStyle As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hWndParent As Long, _
  ByVal hMenu As Long, _
  ByVal hInstance As Long, _
  lpParam As Any _
) As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
( _
  ByVal lpPrevWndFunc As Long, _
  ByVal hWnd As Long, _
  ByVal Msg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long _
) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long _
) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long _
) As Long

Public Const GWL_WNDPROC = -4
Public lpPrevWndProc As Long
Public Function fnWinProc(ByVal hw As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case wMsg
    Case WM_NOTIFY
      If wParam = MY_CUSTOM_CONTROL Then
         Dim wc As WindowColor
         Call ccCrackPointer(lParam, wc)
         MsgBox _
         ( _
           "Received Message From:" & vbCrLf & _
           "      hWnd = " & CStr(wc.lpnmh.hwndFrom) & vbCrLf & _
           "      idFrom = " & CStr(wc.lpnmh.idfrom) & vbCrLf & _
           "      code = " & CStr(wc.lpnmh.code) & vbCrLf & _
           "      strColpr = " & wc.strColor _
         )
      End If
  End Select
     
  fnWinProc = CallWindowProc(lpPrevWndProc, hw, wMsg, wParam, lParam)
End Function


Now frmCusCtrl.frm

Code Select Expand


VERSION 5.00
Begin VB.Form frmCusCtrl
   Caption         =   "Form1"
   ClientHeight    =   1650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1650
   ScaleWidth      =   6435
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton btnRed
      Caption         =   "Red"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   90
      TabIndex        =   3
      Top             =   1080
      Width           =   1185
   End
   Begin VB.CommandButton btnGreen
      Caption         =   "Green"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   90
      TabIndex        =   2
      Top             =   600
      Width           =   1185
   End
   Begin VB.CommandButton btnBlue
      Caption         =   "Blue"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   90
      TabIndex        =   1
      Top             =   120
      Width           =   1185
   End
   Begin VB.PictureBox ctlContainer
      Height          =   1125
      Left            =   1470
      ScaleHeight     =   1065
      ScaleWidth      =   4755
      TabIndex        =   0
      Top             =   210
      Width           =   4815
   End
End
Attribute VB_Name = "frmCusCtrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
  hDll = LoadLibrary(App.Path & "\dllCustomControlServer.dll")
  If blnInitialize() Then
     frmCusCtrl.Caption = "Visual Basic Custom Control Demo"
     lpPrevWndProc = SetWindowLong(ctlContainer.hWnd, GWL_WNDPROC, AddressOf fnWinProc)
     hCus = CreateWindowEx _
     ( _
       0, _
       "Custom_Control", _
       "", _
       WS_CHILD Or WS_VISIBLE, _
       0, _
       0, _
       ctlContainer.Width, _
       ctlContainer.Height, _
       ctlContainer.hWnd, _
       MY_CUSTOM_CONTROL, _
       App.hInstance, _
       ByVal 0 _
     )
  End If
End Sub
Private Sub btnBlue_Click()
  Call SendMessage(hCus, MY_CUSTOM_MESSAGE, RGB(0, 0, 255), 0)
End Sub
Private Sub btnGreen_Click()
  Call SendMessage(hCus, MY_CUSTOM_MESSAGE, RGB(0, 255, 0), 0)
End Sub
Private Sub btnRed_Click()
  Call SendMessage(hCus, MY_CUSTOM_MESSAGE, RGB(255, 0, 0), 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Dim temp As Long
  temp = SetWindowLong(ctlContainer.hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Private Sub Form_Terminate()
  Call FreeLibrary(hDll)
End Sub


I'll attach the various files.

[Frederick J. Harris]

Above files attached