I forget what I was doing.. so my new subclassing routine comes!

[Nicholas Randall Forystek]

'##### FORM/CONTORL INIT/TERM ######

Private Sub Form_Initialize()
HookControl Me
End Sub

Private Sub Form_Terminate()
HookControl Me
End Sub


'##### MODULE WITH THE REST ######


Private Const GWL_WNDPROC = -4
Private Declare Function DefWindowProc Lib "user32" Alias _
"DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long

Public Static Function HookControl(ByRef obj) As Object
Static HookedCtrls As Collection
Static HookedAddrs As Collection
If HookedCtrls Is Nothing Then
Set HookedCtrls = New Collection
Set HookedAddrs = New Collection
End If
If IsNumeric(obj) Then
Set HookControl = HookedCtrls("k" & obj.hWnd)
ElseIf HookedCtrls.Count > 0 Then
Dim cnt As Long
For cnt = 1 To HookedAddrs.Count
If HookedCtrls(cnt).hWnd = obj.hWnd Then
GoTo unhook
End If
Next
HookedCtrls.Add obj, "k" & obj.hWnd
HookedAddrs.Add GetWindowLong(obj.hWnd, GWL_WNDPROC), "k" & obj.hWnd
SetWindowLong obj.hWnd, GWL_WNDPROC, AddressOf ControlWndProc
End If
GoTo hookok
unhook:
SetWindowLong obj.hWnd, GWL_WNDPROC, HookedAddrs("k" & obj.hWnd)
HookedCtrls.Remove "k" & obj.hWnd
HookedAddrs.Remove "k" & obj.hWnd
hookok:
If HookedCtrls.Count = 0 Then
Set HookedCtrls = Nothing
Set HookedAddrs = Nothing
End If
End Function

Private Function ControlWndProc(ByVal hWnd As Long, ByVal uMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Debug.Print TypeName(HookControl(hWnd))
ControlWndProc = DefWIndowProc(hwnd, umsg, wparam, lparam)
End Function