Sunday 22 September 2013

A simple subclassing example

Module Code
option explicit
Private Const GWL_WNDPROC = (-4)
Private Const WM_LBUTTONUP = &H202
Private Const WM_MOUSEMOVE = &H200
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
private originalHandler as long

'Window hooked with Customized function Winproc returning the original handle 
public sub SubClassWindow(handle as long)
   oldWindowHandler = SetWindowLong(handler, GWL_WNDPROC, AddressOf WinProc)
End Sub

'Window restore to it's original Windows procedire
public sub UnSubClass(handle as long)
   call setWindowsLong(handler,, GWL_WNDPROC, oldWindowHandler)
End Sub

'Customized Windows function

private sub WinProc(ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   select case MSG
      ' If user released it's left mouse button
       Case WM_LBUTTONUP
             debug.print "Left Button Up"
       ' If user moved it's mouse
       Case WM_MOUSEMOVE
            debug.print "Mouse Moving"
   End select
  ' Original windows procedure invoked, this is necessary other wise program will crash
  WinProc = CallWindowProc(OldHandler, hWnd, MSG, wParam, lParam)
End Sub

No comments: