With this visual Basic 6.0 Code you can handle more event that visual basic Support as Mouse wheel and hover or you can control event before VB IDE Default Windows proc as WM_CREATE when windows start creation, this task is useful for some application , for example you can create new UI Control at run time using Form1.Control.add("vb.CommandButton","Cmd1") Function and you can handle command button event by WM_COMMAND Message and Command ID
Module1.bas
Expand|Select|Wrap|Line Numbers
- Option Explicit
- 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 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 Sub CopyPtrToObj Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Object, ByRef Source As Long, Optional ByVal Length As Long = 4)
- Private Declare Sub CopyObjToPtr Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByRef Source As Object, Optional ByVal Length As Long = 4)
- Private Const GWL_USERDATA = (-21)
- Private Const GWL_WNDPROC = (-4)
- Private Const WM_MOUSEWHEEL As Long = &H20A
- Private Const WM_MOUSEHOVER As Long = &H21A
- Public Sub ChangeWindowProc(ByVal WindowObject As Object)
- Dim LastFormProc As Long
- Dim WindowObjectPointer As Long
- 'Get Proc Address assigned by VB IDE
- LastFormProc = GetWindowLong(WindowObject.hwnd, GWL_WNDPROC)
- Call CopyObjToPtr(WindowObjectPointer, WindowObject) 'Copy Object memory Pointer to Long variable
- WindowObject.Tag = LastFormProc 'hold lastProc in tag property u can create public variable in each window and assign this value to it and use tag for ur work
- 'Save Last Window Object Pointer in Window Class User Extedned Data,now u can change proc for multiple form at one time
- 'sure user cant active 2 forms in same time, but because of timer event and winsock
- Call SetWindowLong(WindowObject.hwnd, GWL_USERDATA, WindowObjectPointer)
- 'change VB IDE proc by new our Proc Address
- Call SetWindowLong(WindowObject.hwnd, GWL_WNDPROC, AddressOf WindowExtendedEventProc)
- End Sub
- 'Reset Window Proc To Orignal VB IDE Proc.
- Public Sub ResetWindowProc(ByVal WindowObject As Object)
- Dim LastFormProc As Long
- LastFormProc = Val(WindowObject.Tag)
- Call SetWindowLong(WindowObject.hwnd, GWL_USERDATA, LastFormProc)
- End Sub
- 'Our New Window Defined proc
- Public Function WindowExtendedEventProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- 'this variable is static because visual basic will unallocate all objects and variables within function after excution complete
- 'try to change it to Dim FormObject as object your application will crash
- Static FormObject As Object
- Dim LastFormProc As Long
- Dim FormObjectPointer As Long
- 'get Object Pointer Again in long var
- FormObjectPointer = GetWindowLong(hwnd, GWL_USERDATA)
- Call CopyPtrToObj(FormObject, FormObjectPointer) 'this line seems as "Set FormObject=Form1" !!!!
- LastFormProc = Val(FormObject.Tag) 'retrieve LastProc Address From tag
- Select Case Msg
- Case WM_MOUSEWHEEL 'if user Roll Mouse Wheel
- Call FormObject.Form_MouseWheel
- WindowExtendedEventProc = 0
- Exit Function
- Case WM_MOUSEHOVER
- Call FormObject.Form_MouseWheel
- WindowExtendedEventProc = 0
- Exit Function
- End Select
- 'call orignal VB IDE Proc with other windows messages
- WindowExtendedEventProc = CallWindowProc(LastFormProc, hwnd, Msg, wParam, lParam)
- End Function
Form1.frm
Expand|Select|Wrap|Line Numbers
- Option Explicit
- Private Sub Form_Activate()
- Call ChangeWindowProc(Me)
- End Sub
- Private Sub Form_Deactivate()
- Call ResetWindowProc(Me)
- End Sub
- Public Sub Form_MouseWheel()
- MsgBox "mouse Wheel"
- End Sub
- Public Sub Form_MouseHover()
- MsgBox "mouse Wheel"
- End Sub