| This module implements a window hook on a specified form so one can intercept messages that VB doesn't pass on. A couple of warnings, running this code in the IDE can crash the IDE if it tries to stop the code, or hits a breakpoint, in the message hook, so you should only run it as a compiled executable. Also, using End, or otherwise circumventing the UnHook call will cause the app to produce a Fatal Exception. You should add the messages you want handled to the select statement of WProc. |
| Option Explicit
Private Const GWL_WNDPROC = (-4)
Private Const WM_NCDESTROY = &H82
Private 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 Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, src As Any, ByVal length As Long) As Long
Private m_lpPrevProc As Long
Private m_frmHook As Form
Public Sub Hook(frmHook As Form)
Set m_frmHook = frmHook
m_lpPrevProc = GetWindowLong(frmHook.hWnd, GWL_WNDPROC)
SetWindowLong frmHook.hWnd, GWL_WNDPROC, AddressOf WProc
End Sub
Public Sub UnHook()
SetWindowLong m_frmHook.hWnd, GWL_WNDPROC, m_lpPrevProc
End Sub
Public Function WProc(ByVal hWnd As Long, ByVal msg As Long, ByVal _
wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim bRet As Boolean
bRet = True
Select Case msg
Case Is = WM_NCDESTROY
UnHook
End Select
If bRet Then
WProc = CallWindowProc(m_lpPrevProc, frmMain.hWnd, msg, _
wParam, lParam)
End If
End Function
|