What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleUse the Subclasser class to subclass many windows at once
Keywordssubclass, class, Subclasser
When you subclass, you need to pass the address of the new WindowProc function to SetWindowLong. You can only do that if the new WindowProc is in a .BAS module. That means you cannot easily use the same WindowProc for more than one window.

The Subclasser class shown in the following code subclasses and unsubclasses a window. The Subclass method stores the window's hWnd in its own local variable m_hWnd. It stores the window's original WindowProc in the global OldWindowProcs collection and it stores a reference to itself in the global Subclasser's collection.

The UnSubclass method restores the window's original WindowProc and removes its entries in the OldWindowProcs and Subclassers collections.

Subroutine WindowProc processes messages for the control. First it raises the EventReceived event so the main program can process the message. If the event handler doesn't set the process_event variable to False, it calls the window's original WindowProc. Finally, if the message is WM_NCDESTROY, the routine unsubclasses the window.

Public Event EventReceived(ByVal msg As Long, ByVal lParam _
    As Long, ByVal wParam As Long, ByRef process_event As _

Private m_hWnd As Long

' Subclass this window.
Public Sub Subclass(ByVal hWnd As Long)
    ' Make sure the collections are allocated.
    If OldWindowProcs Is Nothing Then
        Set OldWindowProcs = New Collection
        Set Subclassers = New Collection
    End If

    ' If we already represent a subclassed window,
    ' unsubclass it.
    If m_hWnd <> 0 Then UnSubclass
    m_hWnd = hWnd

    ' Subclass, saving the old WindowProc
    ' with the hWnd as key.
    OldWindowProcs.Add _
        SetWindowLong( _
            hWnd, GWL_WNDPROC, _
            AddressOf NewWindowProc), Str$(m_hWnd)

    ' Save a reference to ourself
    ' with the hWnd as key.
    Subclassers.Add Me, Str$(m_hWnd)
End Sub

' Unsubclass this hWnd.
Public Sub UnSubclass()
    ' Do nothing if we aren't subclassing.
    If m_hWnd = 0 Then Exit Sub

    ' Restore the original WindowProc.
    SetWindowLong _
        m_hWnd, GWL_WNDPROC, _

    ' Remove the original WindowProc and ourself
    ' from the collections.
    OldWindowProcs.Remove Str$(m_hWnd)
    Subclassers.Remove Str$(m_hWnd)
    m_hWnd = 0
End Sub

' Process the message.
Public Function WindowProc(ByVal msg As Long, ByVal wParam _
    As Long, ByVal lParam As Long) As Long
Dim process_event As Boolean

    ' Raise the EventReceived event.
    process_event = True
    RaiseEvent EventReceived(msg, lParam, wParam, _

    ' Process the event normally.
    If process_event Then
        WindowProc = CallWindowProc( _
            OldWindowProcs(Str$(m_hWnd)), _
            m_hWnd, msg, wParam, lParam)
    End If

    ' If we're being destroyed, unsubclass.
    If msg = WM_NCDESTROY Then UnSubclass
End Function
The following code shows the new WindowProc function shared by all of the subclassed windows. It finds the Subclasser for the hWnd and calls that object's WindowProc function.
' Process messages for an hWnd.
Public Function NewWindowProc(ByVal hWnd As Long, ByVal msg _
    As Long, ByVal wParam As Long, ByVal lParam As Long) As _
Dim sub_classer As Subclasser

    ' Find the appropriate subclasser.
    Set sub_classer = Subclassers(Str$(hWnd))
    NewWindowProc = sub_classer.WindowProc(msg, wParam, _
End Function
For more information on subclassing including important precautions, see Tutorial: Subclassing.
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.