Visual Basic/Subclassing

      Subclassing can be useful when you want to add functionality that is not directly supported by Visual Basic. To explain how this works we must first go through a little background theory.

      All windows in Windows (for example a form, a button, a listbox, etc.) have a function that the operating system or other programs can call to communicate with the program. Windows can, for example, send messages about events such as the mouse pointer moving over the window, a key being pressed when the window has the focus and much more. Programs can also send messages that ask for information about the window; for example, the EM_GETLINECOUNT message asks a textbox to send back the number of lines in the text it holds. One can also define one's own functions.

      To call these special functions you can use PostMessage, SendMessage or CallWindowProc (the last only if you know the address of the function).

      Usually such a procedure looks something like this:

        Public Function WindowProc(ByVal hwnd As Long, _
                                   ByVal uMsg As Long, _
                                   ByVal wParam As Long, _ 
                                   ByVal lParam As Long) As Long
       
          ' Your code here
          
          Select Case uMsg
            Case 0
              ' React to message 0 
            Case 1
              ' React to message 1
          End Select
       
          WindowProc = 0 ' Return a value to the caller
              
         End Function
      

      In this function hwnd is the handle of the window that the caller has tried to contact; uMsg is the message identifier which says what the call is about; wParam and lParam are used for whatever purpose the caller and window agree on. The handle, hwnd, is not an address but is used by Windows to find the address.

      If, for example, we want to set the text that appears on the title bar of a form we can use the following code:

        Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _ 
                 ByVal wMsg As Long, _
                 ByVal wParam As Integer, _
                 ByVal lParam As Any) As Long
       
          Private Const WM_SETTEXT = &HC
       
        Private Sub Form_Load()  
          SendMessage Me.hwnd, WM_SETTEXT, 0&, "This is a test"
        End Sub
       
      The receiver will get this message via its window function, which will look something like this:
       
        Public Function WindowProc(ByVal hwnd As Long, _
                                   ByVal uMsg As Long, _
                                   ByVal wParam As Long, _ 
                                   ByVal lParam As Long) As Long
       
          ' hwnd is now equal to Me.hwnd, 
          ' uMsg is WM_SETTEXT, 
          ' wParam is 0 
          ' lParam is the address of the text: "This is a test"
                      
          ' It doesn't actually look like this of course, but this gives 
          ' a good enough impression of what happens under the surface
          Select Case uMsg
              Case WM_SETTEXT 
              Me.Caption = lParam
            'Case ...
              '... many more here
          End Select    
        End Function
      

      Why Subclass

      What is the point of subclassing?

      Using this technique we can completely replace a program's own window function with our own. Then we can respond to the messages in ways that Visual Basic doesn't, we can decide to send the messages further to the original window function or not as we like, modifying them on the way in any way we please.

      ↑Jump back a section

      Example

      To specify that our window function is to be used we use the API call SetWindowLong. Study the following example and put it in a base module:

        Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                (ByVal hwnd As Long, _
                 ByVal nIndex As Long, _  
                 ByVal dwNewLong As Long) 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 SetClipboardViewer Lib "user32" _
                (ByVal hwnd As Long) As Long
       
        Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                 ByVal wMsg As Long, _ 
                 ByVal wParam As Integer, _
                 ByVal lParam As Any) As Long
       
        Public Const WM_SETTEXT = &HC
        Public Const GWL_WNDPROC = (-4)
       
        Private PrevProc As Long ' The address of the original window function
          
        Public Sub SubclassForm(F As Form)  
          ' AddressOf WindowProc = finds the address of a function
          PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
        End Sub
       
        Public Sub UnSubclassForm(F As Form)    
          ' It is _very_ important that we restore the original window function,
          ' because VB will crash if we don't.
          SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
        End Sub
       
        Public Function WindowProc(ByVal hwnd As Long, _
                                   ByVal uMsg As Long, _
                                   ByVal wParam As Long, _ 
                                   ByVal lParam As Long) As Long
       
          Dim sTemp As String
       
          If uMsg = WM_SETTEXT Then
            ' Don't let the text get through, replace it with our own. Also, because all
            ' strings in VB are of the format UTF-16 (Unicode) and the receiving method
            ' expects a zero-terminated ASCII-string, it is necessary to convert it before
            ' passing it further down the chain.
            sTemp = StrConv("Subclassing" & Chr(0), vbFromUnicode)
            lParam = StrPtr(sTemp) ' get the address of our text
          End If
       
          ' Call the original function
          WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
        End Function
      

      Add a form with a button cmdTest and add this code:

        Private Sub cmdTest_Click()
          SendMessage Me.hwnd, WM_SETTEXT, 0&, "This is a test"
        End Sub
       
        Private Sub Form_Load()    
          ' Start subclassing
          SubclassForm Me    
        End Sub
       
        Private Sub Form_Unload(Cancel As Integer)
          ' WARNING: If you stop the project (for example with the stop button) without calling this, 
          ' your program, as well as the VB IDE, will most likely crash.
          UnSubclassForm Me
        End Sub
      

      When you click the cmdTest button, you'll see that the text that appears is not "This is a test", but "Subclassing".

      Previous: Windows_API Contents Next: External_Processes
      ↑Jump back a section
      Last modified on 2 November 2010, at 16:43