Subclassing Class and Module...can anyone see whats wrong???
VB Code:
'In Module:
Option Explicit
Const GWL_WNDPROC = -4
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal ndx As Long, ByVal newValue 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
Private Type mtypWindowInfoUDT
hWnd As Long
OldWndProc As Long
MsgHook As MsgHook
End Type
Dim mudtWindowInfo() As mtypWindowInfoUDT
Dim mlngmudtWindowInfoCount As Long
Public Sub HookWindow(ByRef pobjMsgHook As MsgHook, ByVal hWnd As Long)
If mlngmudtWindowInfoCount = 0 Then
ReDim mudtWindowInfo(10) As mtypWindowInfoUDT
ElseIf mlngmudtWindowInfoCount > UBound(mudtWindowInfo) Then
ReDim Preserve mudtWindowInfo(mlngmudtWindowInfoCount + 9) As mtypWindowInfoUDT
End If
mlngmudtWindowInfoCount = mlngmudtWindowInfoCount + 1
With mudtWindowInfo(mlngmudtWindowInfoCount)
.hWnd = hWnd
Set .MsgHook = pobjMsgHook
.OldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End With
End Sub
Public Sub UnhookWindow(ByRef pobjMsgHook As MsgHook)
Dim lngIndex As Long
For lngIndex = 1 To mlngmudtWindowInfoCount
If mudtWindowInfo(lngIndex).MsgHook Is pobjMsgHook Then
SetWindowLong mudtWindowInfo(lngIndex).hWnd, GWL_WNDPROC, mudtWindowInfo(lngIndex).OldWndProc
mudtWindowInfo(lngIndex) = mudtWindowInfo(mlngmudtWindowInfoCount)
mlngmudtWindowInfoCount = mlngmudtWindowInfoCount - 1
Exit For
End If
Next lngIndex
End Sub
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lngIndex As Long
Const WM_DESTROY = &H2
For lngIndex = 1 To mlngmudtWindowInfoCount
If mudtWindowInfo(lngIndex).hWnd = hWnd Then
WndProc = mudtWindowInfo(lngIndex).MsgHook.WndProc(hWnd, uMsg, wParam, lParam, mudtWindowInfo(lngIndex).OldWndProc)
If uMsg = WM_DESTROY Then
Call mudtWindowInfo(lngIndex).MsgHook.StopSubclass
End If
Exit For
End If
Next lngIndex
End Function
and...
VB Code:
'In a class
Option Explicit
Event BeforeMessage(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef RetValue As Long, ByRef Cancel As Boolean)
Event AfterMessage(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private mlnghWnd As Long
Public Sub StartSubclass(ByVal hWnd As Long)
If mlnghWnd Then
Call StopSubclass
End If
mlnghWnd = hWnd
If mlnghWnd Then
Call HookWindow(Me, mlnghWnd)
End If
End Sub
Public Sub StopSubclass()
If mlnghWnd Then
Call UnhookWindow(Me)
End If
End Sub
Friend Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal oldWindowProc As Long) As Long
Dim blnCancel As Boolean
Dim lngRet As Long
RaiseEvent BeforeMessage(hWnd, uMsg, wParam, lParam, lngRet, blnCancel)
If Not blnCancel Then
lngRet = CallWindowProc(oldWindowProc, hWnd, uMsg, wParam, lParam)
End If
RaiseEvent AfterMessage(hWnd, uMsg, wParam, lParam)
WndProc = lngRet
End Function
Private Sub Class_Terminate()
Call StopSubclass
End Sub
