Modularised Subclassing The Same Object Twice

This article is based on Visual Basic 6. Find other Visual Basic 6 articles.

Note: This artical references alot of what was already covered in the Modularised subclassing artical which is located here.

In an extension of this method, it is possible to 'modularise' subclassing and have your subclassing handled inside a form or class module.

To do this you will need an extra class module, called ISubclass:

 Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, bHandled As Boolean, RetVal As Boolean) As Long
 
 End Function

This class looks useless, and, on its own, is. However, what you have created with this class is an interface that can be 'implemented' (a form of inheritance supported by VB6) into other class modules, and forms. You could omit this and opt for a simpler, but less flexible, solution, but if you are familiar with inheritance then the benefits of using this particular method will be apparent. If you are not familiar with implementation inheritance then there are plenty of tutorials out there - http://www.google.co.uk/search?hl=en&safe=off&q=vb6+implementation+inheritance&spell=1

Now for the module coding: The module will work much in the same way as the previous example, except for the fact that you are not passed a pointer or a reference to your module function, which is the Window Procedure for whatever window you are subclassing. So how do you get access to your object? You use ObjPtr and SetProp as follows:

First things first, we will have to write a function to subclass a window (note: API declarations are not shown here).

 Public Sub SubclassWnd(ByVal Hwnd As Long, oHandler As ISubclass)
   'Define all the variables
   Dim lngOrginalProc As Long
   Dim pOldWndProc As Long
   Dim x As Integer
   
   'Subclass the window and save the windows orginal proc handle if it's not already saved
   lngOrginalProc = SetWindowLong(Hwnd, StyleConstants.GWL_WNDPROC, AddressOf fnWndProc)
   pOldWndProc = GetProp(Hwnd, "pOldWndProc")
   If pOldWndProc = 0 Then Call SetProp(Hwnd, "pOldWndProc", lngOrginalProc)
   
   'Save the new handler procs
   x = 0
   Do Until GetProp(Hwnd, "pHandler" & x) = 0: x = x + 1: Loop
   Call SetProp(Hwnd, "pHandler" & x, ObjPtr(oHandler))
 End Sub

What's going on here? The sub is passed a reference to an instance of ISubclass (which is really a reference to your class/form that is type-compatible with ISubclass because it implements it). Once the window is subclassed in the normal way, we use SetProp to give the window a property telling us what the old window proc address is, and one which is a pointer to our ISubclass instance. As we are passed the hwnd of the window in the Window Procedure, we can then use the properties of the window to retrieve the ISubclass object and call methods on it.

New: A few things I added to the SubclassWnd sub was a check to make sure the default proc (pOldWndProc) never gets changed more then once. This makes sure the default object messages get processed. If this was not done then the app would have an overflowing amount of messages processing and drop into an endless loop which in turn would cause the IDE to crash. I also added an array of handlers instead of a single one. The array is not actually an array per-say but a bunch of handlers that kinda act as an array using numbers at the end of the property. With this added when can make sure that ALL the handler functions recive the messages related to the object being subclassed.

Before we proceed with the Window Procedure, let's just make a quick sub to un-subclass the window:

 Public Sub UnSubclassWnd(ByVal Hwnd As Long)
   'Define all the variables
   Dim lngOrginalProc As Long
   Dim x As Integer
   
   'Release the subclass back to normal window handle
   lngOrginalProc = GetProp(Hwnd, "pOldWndProc")
   Call SetWindowLong(Hwnd, StyleConstants.GWL_WNDPROC, lngOrginalProc)
   Call RemoveProp(Hwnd, "pOldWndProc")
   x = 0
   Do Until GetProp(Hwnd, "pHandler" & x) = 0
     Call RemoveProp(Hwnd, "pHandler" & x)
     x = x + 1
   Loop
 End Sub

As you can see, the use of GetProp is demonstrated here in order to get the old Window Proc address and set it back to that. RemoveProp is also used to clean up a bit.

New: Here in the UnSubclassWnd sub there is the same "array" method i used to remove ALL of the props from the handle.

On with the Window Proc:

 Private Function fnWndProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   'Define all the variables
   Dim pOldWndProc As Long
   Dim pHandler As Long
   Dim oHandler As subclasshook
   Dim bHandled As Boolean
   Dim bRet As Boolean
   Dim RetVal As Long
   Dim pHandlerStack() As Long
   Dim x As Integer
   
   'Get the orginal window proc
   pOldWndProc = GetProp(Hwnd, "pOldWndProc")
   
   'Get all the proc handler functions in an array so we can process them all
   ReDim pHandlerStack(10)
   x = 0
   pHandler = GetProp(Hwnd, "pHandler0")
   Do Until pHandler = 0
     If x > UBound(pHandlerStack) Then ReDim Preserve pHandlerStack(x + 10)
     pHandlerStack(x) = pHandler
     x = x + 1
     pHandler = GetProp(Hwnd, "pHandler" & x)
   Loop
   ReDim Preserve pHandlerStack(x - 1)
   
   For x = 0 To UBound(pHandlerStack)
     If pHandlerStack(x) <> 0 Then
       CopyMemory oHandler, pHandlerStack(x), 4&
       RetVal = oHandler.WndProc(Hwnd, uMsg, wParam, lParam, bHandled, bRet)
       ZeroMemory oHandler, 4&
     End If
        
     If Not bHandled Then
       If Not bRet Then
         fnWndProc = CallWindowProc(pOldWndProc, Hwnd, uMsg, wParam, lParam)
       Else
         Call CallWindowProc(pOldWndProc, Hwnd, uMsg, wParam, lParam)
         fnWndProc = RetVal
       End If
     Else
       If Not bRet Then
         fnWndProc = 0
       Else
         fnWndProc = RetVal
       End If
     End If
   Next x
 End Function

While this may look a little daunting at first, the only complex thing that is going on here really is the usage of GetProp and CopyMemory to get an ISubclass instance. This works exactly the same as getting the old Window Proc address as we did in the unsubclassing procedure, and exactly the same as getting an object reference from a pointer in the previous example.

New: Basicly here in the fnWndProc function we just simply go through each of the handler functions to make sure all the handlers get the single message being processed.

All of the rest of the function is simply to handle return values and the 'bHandled' variable that is passed to ISubclass.WndProc. If ISubclass.WndProc returns with bHandled true then CallWindowProc and DefWindowProc are not called, otherwise one or the other is called depending on whether or not GetProp returned to us a proper address for the old Window Proc. In all cases, if bRet is true when ISubclass.WndProc returns then the return value of ISubclass.WndProc is returned with fnWndProc. Otherwise the return of CallWindowProc/DefWindowProc or 0 is returned.