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 _
    Boolean)

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, _
        OldWindowProcs(Str$(m_hWnd))

    ' 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
Const WM_NCDESTROY = &H82
Dim process_event As Boolean

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

    ' 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

' 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 _
    Long
Dim sub_classer As Subclasser

    ' Find the appropriate subclasser.
    Set sub_classer = Subclassers(Str$(hWnd))
    NewWindowProc = sub_classer.WindowProc(msg, wParam, _
        lParam)
End Function