Ok no fail I promise this time:

[Nicholas Randall Forystek]

Open VB6, start a new Standard EXE project and the code inbetween the
'#####'s copy&paste into the form code.
Everything else after the second '##### put into a newly created module you
must add to the project. Then run
it and after you do that, stop it and remove the following like of code
"ControlWndProc = DefWIndowProc(hwnd,
umsg, wparam, lparam)" and try running it again.


'#####

Private Sub Form_Initialize()
HookControl Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
HookControl Me
End Sub

'#####

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 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

Public Function HookControl(ByRef obj)
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
If obj < 0 Then
HookControl = HookedAddrs("k" & -obj)
Else
Set HookControl = HookedCtrls("k" & obj)
End If
Else
Dim cnt As Long
If HookedCtrls.Count > 0 Then
For cnt = 1 To HookedCtrls.Count
If HookedCtrls(cnt).hWnd = obj.hWnd Then
SetWindowLong obj.hWnd, GWL_WNDPROC, _
HookedAddrs("k" & obj.hWnd)
HookedCtrls.Remove "k" & obj.hWnd
HookedAddrs.Remove "k" & obj.hWnd
GoTo hookok
End If
Next
End If
HookedCtrls.Add obj, "k" & obj.hWnd
HookedAddrs.Add SetWindowLong(obj.hWnd, _
GWL_WNDPROC, AddressOf ControlWndProc), "k" & obj.hWnd
End If
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)) & hWnd & _
", " & uMsg & ", " & wParam & ", " & lParam
If (HookControl(-hWnd) <> 0) Then
If CallWindowProc(HookControl(-hWnd), hWnd, uMsg, wParam, lParam) =
0 Then
ControlWndProc = 1
Else
ControlWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End If
Else
ControlWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End If
End Function