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
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:
Post a Comment