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
#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
#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
QuoteFinally, 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.
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
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...
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....
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...
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.
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.
'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
'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
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.
Above files attached