Symptoms
In Windows programming terminology, subclassing is the process of creatinga message handling procedure to intercept messages for a given window,handling those messages, and passing any remaining messages to the window’soriginal message handler.
This article demonstrates how to subclass a UserControl in Visual Basicusing the AddressOf operator.
Resolution
WARNING: One or more of the following functions are discussed in this article; VarPtr, VarPtrArray, VarPtrStringArray, StrPtr, ObjPtr. These functions are not supported by Microsoft Technical Support. They are not documented in the Visual Basic documentation and are provided in this Knowledge Base article “as is.” Microsoft does not guarantee that they will be available in future releases of Visual Basic.
In Visual Basic, the AddressOf operator is used to specify whichfunction in a code module (.BAS file) will be the message handlingprocedure. The subclass procedure is basically a message filter thatperforms non-default processing for a few key messages, and passes othermessages to a default window procedure using CallWindowProc API. TheCallWindowProc API function passes a message to the Windows system, which,in turn, sends the message to the specified window procedure.
When subclassing a UserControl with the AddressOf operator, you must takeinto account that multiple instances of the control utilize the same codemodule and its functions. In order for the UserControl to maintain its”own” message handling function, the common procedure in the module needsto forward the messages to the proper instance of the UserControl.
To implement a function for each instance of a UserControl, you need tocreate a function in the UserControl to process the messages. The currentrequirement of Visual Basic is that the AddressOf operator can only beused for functions residing in a .BAS module. Therefore, the function inthe .BAS module must forward the message to the correct instance of theUserControl.
The following steps show how to create a UserControl that detects mouseactivation at design-time and run-time.
WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWNRISK. Microsoft provides this code “as is” without warranty of any kind, either express or implied, including but not limited to the impliedwarranties of merchantability and/or fitness for a particular purpose.
WARNING: Failure to unhook a window before its imminent destruction willresult in application errors, Invalid Page Faults, and data loss. This isdue the fact that the new WindowProc function being pointed to no longerexists, but the window has not been notified of the change. Always unhookthe sub-classed window upon unloading the sub-classed UserControl orexiting the application. This is especially important while debugging anapplication that uses this technique within the Microsoft Visual BasicDevelopment Environment. Pressing the End button or selecting End from theRun menu without unhooking will cause an Invalid Page Fault and closeMicrosoft Visual Basic.
Step-by-Step ExampleStart Visual Basic and create a new ActiveX Control Project.”UserControl1″ is created by default.Add the following code to the UserControl1 code module:
Option Explicit’mWndProcOrg holds the original address of the’Window Procedure for this window. This is used to’route messages to the original procedure after you’process them.Private mWndProcOrg As Long’Handle (hWnd) of the subclassed window.Private mHWndSubClassed As Long’Constant for Windows Message used in sample.Private Const WM_MOUSEACTIVATE = &H21Private Sub SubClass()’————————————————————-’Initiates the subclassing of this UserControl’s window (hwnd).’Records the original WinProc of the window in mWndProcOrg.’Places a pointer to the object in the window’s UserData area.’————————————————————-’Exit if the window is already subclassed.If mWndProcOrg Then Exit Sub’Redirect the window’s messages from this control’s default’Window Procedure to the SubWndProc function in your .BAS’module and record the address of the previous Window’Procedure for this window in mWndProcOrg.mWndProcOrg = SetWindowLong(hWnd, GWL_WNDPROC, _AddressOf SubWndProc)’Record your window handle in case SetWindowLong gave you a’new one. You will need this handle so that you can unsubclass.mHWndSubClassed = hWnd’Store a pointer to this object in the UserData section of’this window that will be used later to get the pointer to’the control based on the handle (hwnd) of the window getting’the message.Call SetWindowLong(hWnd, GWL_USERDATA, ObjPtr(Me))End SubPrivate Sub UnSubClass()’———————————————————–’Unsubclasses this UserControl’s window (hwnd), setting the’address of the Windows Procedure back to the address it was’at before it was subclassed.’———————————————————–’Ensures that you don’t try to unsubclass the window when’it is not subclassed.If mWndProcOrg = 0 Then Exit Sub’Reset the window’s function back to the original address.SetWindowLong mHWndSubClassed, GWL_WNDPROC, mWndProcOrg’0 Indicates that you are no longer subclassed.mWndProcOrg = 0End SubFriend Function WindowProc(ByVal hWnd As Long, _ByVal uMsg As Long, ByVal wParam As Long, _ByVal lParam As Long) As Long’————————————————————–’Process the window’s messages that are sent to your UserControl.’The WindowProc function is declared as a “Friend” function so’that the .BAS module can call the function but the function’cannot be seen from outside the UserControl project.’————————————————————–’Start Demo Code: Changes the color of the UserControl each’time the control is clicked in design-time from red to blue’or from blue to red.If uMsg = WM_MOUSEACTIVATE ThenIf UserControl.BackColor = vbRed ThenUserControl.BackColor = vbBlueElseUserControl.BackColor = vbRedEnd IfEnd If’End Demo Code.’Forwards the window’s messages that came in to the original’Window Procedure that handles the messages and returns’the result back to the SubWndProc function.WindowProc = CallWindowProc(mWndProcOrg, hWnd, _uMsg, wParam, ByVal lParam)End FunctionPrivate Sub UserControl_Initialize()’Occurs the first time a UserControl is placed on a container.UserControl.BackColor = vbRedSubClassEnd SubPrivate Sub UserControl_Terminate()UnSubClassEnd Sub Add new Standard Module (.BAS) to the project and add the followingcode:
Option Explicit’API Declarations used for subclassing.Public Declare Sub CopyMemory _Lib “kernel32″ Alias “RtlMoveMemory” _(pDest As Any, _pSrc As Any, _ByVal ByteLen As Long)Public Declare Function SetWindowLong _Lib “user32″ Alias “SetWindowLongA” _(ByVal hWnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongPublic Declare Function GetWindowLong _Lib “user32″ Alias “GetWindowLongA” _(ByVal hWnd As Long, _ByVal nIndex As Long) As LongPublic 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’Constants for GetWindowLong() and SetWindowLong() APIs.Public Const GWL_WNDPROC = (-4)Public Const GWL_USERDATA = (-21)’Used to hold a reference to the control to call its procedure.’NOTE: “UserControl1″ is the UserControl.Name Property at’design-time of the .CTL file.’(‘As Object’ or ‘As Control’ does not work)Dim ctlShadowControl As UserControl1′Used as a pointer to the UserData section of a window.Dim ptrObject As Long’The address of this function is used for subclassing.’Messages will be sent here and then forwarded to the’UserControl’s WindowProc function. The HWND determines’to which control the message is sent.Public Function SubWndProc( _ByVal hWnd As Long, _ByVal Msg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongOn Error Resume Next’Get pointer to the control’s VTable from the’window’s UserData section. The VTable is an internal’structure that contains pointers to the methods and’properties of the control.ptrObject = GetWindowLong(hWnd, GWL_USERDATA)’Copy the memory that points to the VTable of our original’control to the shadow copy of the control you use to’call the original control’s WindowProc Function.’This way, when you call the method of the shadow control,’you are actually calling the original controls‘ method.CopyMemory ctlShadowControl, ptrObject, 4′Call the WindowProc function in the instance of the UserControl.SubWndProc = ctlShadowControl.WindowProc(hWnd, Msg, _wParam, lParam)’Destroy the Shadow Control CopyCopyMemory ctlShadowControl, 0&, 4Set ctlShadowControl = NothingEnd Function NOTE: If your UserControl is not named UserControl1, you need to changethe “Dim ctlControl As UserControl1″ line of code to indicate thecorrect name of your UserControl as specified by its Name property.
Close all the project windows that may be open and save the project.NOTE: During subclassing, you do not want to stop the executing code orit will cause an exception. Always save your project before testing anysubclassing code.
From the File menu, select “Add Project…” and add a Standard EXEproject. This will be your test project. It is named Project2 bydefault.Open the default form (Form1) of Project2 and place an instance of theUserControl on the form. It should appear as a red rectangle.Each time the mouse is clicked on the UserControl, it should toggle itscolor between red and blue.Place a second instance of the UserControl on the form. Note that thesubclassing works independently on each control, sending the messages tothe appropriate control.
