The way I do it, based on the WFS and some stuff from Aaron Ballman…
Global module called WndProchelpers
Methods:
Protected Sub Subclass(wnd as Window, proc as WndProcSubclass)
#if TargetWin32 then
// Do a sanity check
if wnd = nil or proc = nil then return
// Now make sure we have the wnd procs and subclasses
if mOldWndProc = nil then mOldWndProc = new Dictionary
if mSubClass = nil then mSubClass = new Dictionary
// Check to see if we've already subclassed this window.
if mOldWndProc.HasKey( wnd.Handle ) then return
// Now we want to set the new window procedure. This call will return
// the old window procedure, so we don't need to call GetWindowLong
Declare Function SetWindowLongA Lib "User32" ( hwnd as Integer, index as Integer, newValue as Ptr ) as Integer
Const GWL_WNDPROC = -4
dim oldWndProc as Integer = SetWindowLongA( wnd.Handle, GWL_WNDPROC, AddressOf WndProc )
// Now save the old window procedure into our list. We'll
// reference it by the window's handle
mOldWndProc.Value( wnd.Handle ) = oldWndProc
// We'll also save off the interface to call, again, referencing
// it by the window handle
mSubClass.Value( wnd.Handle ) = proc
#endif
End Sub
[code]Protected Sub Unsubclass(wnd as Window)
#if TargetWin32 then
// Sanity check
if wnd = nil then return
// Check to see if we've subclassed this window
if not mOldWndProc.HasKey( wnd.Handle ) then return
// Get the old window procedure handle
dim oldWndProc as Integer = mOldWndProc.Value( wnd.Handle )
// We want to restore the old window procedure to the window. We
// don't care about the return value either
Declare Sub SetWindowLongA Lib "User32" ( hwnd as Integer, index as Integer, newValue as Integer )
Const GWL_WNDPROC = -4
SetWindowLongA( wnd.Handle, GWL_WNDPROC, oldWndProc )
// Now remove this window from our subclass list
mOldWndProc.Remove( wnd.Handle )
mSubClass.Remove( wnd.Handle )
#endif
End Sub[/code]
Private Function WndProc(hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer) as Integer
#if targetwin32
Declare Function DefWindowProcA Lib "User32" ( hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer ) as Integer
// Do a sanity check to see if we've subclassed this window or not.
if not mSubclass.HasKey( hwnd ) then
// Something's not right here, so just call the default window procedure
return DefWindowProcA( hwnd, msg, wParam, lParam )
end if
// We know that we've got a subclass, so call it's window procedure.
dim handled as Boolean
dim subclass as WndProcSubclass = mSubclass.Value( hwnd )
dim ret as Integer = subclass.WndProc( hwnd, msg, wParam, lParam, handled )
// If the user handled the function, then we want to return
// with the value they passed us
if handled then return ret
// Otherwise we want to pass the function along to the old window
// procedure so it can handle it
Declare Function CallWindowProcA Lib "User32" ( proc as Integer, hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer ) as Integer
return CallWindowProcA( mOldWndProc.Value( hwnd ), hwnd, msg, wParam, lParam )
#endif
End Function[/code]
On a window where I want to detect some messages, I Subclass it once, and unSubClass it when closing
[code]//first activation
#if TargetWin32 then
WndProcHelpers.Subclass self,app
#endif
//closing
#if TargetWin32 then
WndProcHelpers.Unsubclass( self )
#endif
It has a WndProc method holding code for the stuff I want to catch, here its WM_mousemove
[code]Public Function WndProc(hWnd as Integer, msg as Integer, wParam as Integer, lParam as Integer, ByRef returnValue as Integer) as Boolean
// Part of the WndProcSubclass interface.
dim x as integer
dim handled as boolean
Const WM_MOUSEMOVE = &h0001
if msg <> WM_MOUSEMOVE then
handled = false
return handled
end if
// Now we know this is our message, so we’re handling it
handled = true
//some message constants
Const WM_LBUTTONDOWN = &h201
Const WM_RBUTTONDOWN = &h204
// Check to see what the true message is and call one of our user
// defined events as appropriate
select case lParam
case WM_LBUTTONDOWN
//stuff
case WM_RBUTTONDOWN
//stuff
end select
return handled
Exception
writelog “Error in wndproc”
End Function[/code]