RAFAAJ
asked on
Detect if Mouse Wheel is rolled Up or Down !!!
Hi all,
I have installed a Mouse Hook which sucessfully detects when the Mouse Wheel is rolled (WM_MOUSEWHEEL).
However I can't tell whether the Wheel was rolled Up or Down :(
Any idea how thie can be done ?
Regards.
I have installed a Mouse Hook which sucessfully detects when the Mouse Wheel is rolled (WM_MOUSEWHEEL).
However I can't tell whether the Wheel was rolled Up or Down :(
Any idea how thie can be done ?
Regards.
Download from this link: http://www.geocities.com/egl1044/mousewheel.zip
Then all you need to do is add the lines below to the form.
Private Sub Form_Load()
Mouse_HookForm Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
Mouse_UnhookForm Me.Hwnd
End Sub
Then all you need to do is add the lines below to the form.
Private Sub Form_Load()
Mouse_HookForm Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
Mouse_UnhookForm Me.Hwnd
End Sub
ASKER
Thanks for the reply Jarnsater.
I am not using Subclassing because it freezes the Excel Application. Instead I have install a Thread specific Mouse Hook which seems to work fine with no adverse effects.
Here, the wParam holds the WM_MOUSEWHEEL Msg , so I don't think we can use it to determine the UP\DOWN values.
Here is a Summary of the code ( CallBack Proc) :
'=========================
Public Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim jumplength As Long
On Error Resume Next
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\\\ This is where I need to test for the Up\Down rolling
LowLevelMouseProc = False
End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
'=========================
Any Suggestions ?
Thank you.
I am not using Subclassing because it freezes the Excel Application. Instead I have install a Thread specific Mouse Hook which seems to work fine with no adverse effects.
Here, the wParam holds the WM_MOUSEWHEEL Msg , so I don't think we can use it to determine the UP\DOWN values.
Here is a Summary of the code ( CallBack Proc) :
'=========================
Public Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim jumplength As Long
On Error Resume Next
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\\\ This is where I need to test for the Up\Down rolling
LowLevelMouseProc = False
End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
'=========================
Any Suggestions ?
Thank you.
You have to set a boolean flag. Overlook the module from the link I posted.
ASKER
Can the above be done using a Windows Mouse Hook instead of Subclassing ? If so, can someone please show me a working example.
Regards.
Regards.
According to msdn, the lParam is a pointer to an MSLLHOOKSTRUCT. This struct contains a member called "mouseData" which contains the same data as the wParam I talked about earlier (get the high word etc).
So you need to declare the MSLLHOOKSTRUCT yourself in VB (a VB "Type") and copy memory from the pointer to a variable of that type.
Msdn about lowlevelmousehook:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/lowlevelmouseproc.asp
Msdn about MSLLHOOKSTRUCT:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookstructures/msllhookstruct.asp
So you need to declare the MSLLHOOKSTRUCT yourself in VB (a VB "Type") and copy memory from the pointer to a variable of that type.
Msdn about lowlevelmousehook:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/lowlevelmouseproc.asp
Msdn about MSLLHOOKSTRUCT:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookstructures/msllhookstruct.asp
Here's an example:
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Jarnsater,
Your suggestion worked beautifully !!! Thank you very much.
In case anyone is interested, what I was trying to achieve is to be able to Scroll Up & Down a ComboBox Control placed on an Excel Worksheet with the Mouse Wheel whenever the control has the Focus.
As you may know,this is impossible to achieve with Excel native tools alone. I thought about Subclassing the ComboBox so I could catch the 'WM_MOUSEWHEEL ' but Because Controls placed on Woeksheets are not true Windows they have no hwnd , and therefore Subclassing them is not possible as opposed to Controls in VB which are true Windows each having a hwnd.
Surprisingly, Hooking the Mouse within XL doesn't cause any appearant problems !!! and did solve the problem :)
Below is the code :
' In a Standard Module (BAS)
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Type POINTAPI
X As Long
Y As Long
End Type
Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data
pt As POINTAPI
mouseData As Long ' Holds Forward\Bacward flag
flags As Long
time As Long
dwExtraInfo As Long
End Type
Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Dim hhkLowLevelMouse, lngInitialColor As Long
Dim udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
'=========================
'\\Copy the Data from lParam of the Hook Procedure argument to our Struct
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function
'=========================
Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Avoid XL crashing if RunTime error occurs due to Mouse fast movement
On Error Resume Next
' \\ Unhook & get out in case the application is deactivated
If GetForegroundWindow <> FindWindow("XLMAIN", Application.Caption) Then
Sheets("Sheet1").ComboBox1
UnHook_Mouse
Exit Function
End If
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\ Don't process Default WM_MOUSEWHEEL Window message
LowLevelMouseProc = True
'\\ Change Sheet&\DropDown names as required
With Sheets("Sheet1").ComboBox1
'\\ if rolling forward increase Top index by 1 to cause an Up Scroll
If GetHookStruct(lParam).mous
.TopIndex = intTopIndex - 1
'\\ Store new TopIndex value
intTopIndex = .TopIndex
Else '\\ if rolling backward decrease Top index by 1 to cause _
'\\a Down Scroll
.TopIndex = intTopIndex + 1
'\\ Store new TopIndex value
intTopIndex = .TopIndex
End If
End With
End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
'=========================
Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub
'=========================
Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub
**************************
' Code In the WorkSheet Module where the ComBobox is placed.
Private Sub ComboBox1_GotFocus()
'Store the first TopIndex Value
intTopIndex = ComboBox1.TopIndex
Hook_Mouse
End Sub
Private Sub ComboBox1_LostFocus()
UnHook_Mouse
End Sub
I couldn't have done it without your help....Thank you very much Jarnsater.
Regards.
Your suggestion worked beautifully !!! Thank you very much.
In case anyone is interested, what I was trying to achieve is to be able to Scroll Up & Down a ComboBox Control placed on an Excel Worksheet with the Mouse Wheel whenever the control has the Focus.
As you may know,this is impossible to achieve with Excel native tools alone. I thought about Subclassing the ComboBox so I could catch the 'WM_MOUSEWHEEL ' but Because Controls placed on Woeksheets are not true Windows they have no hwnd , and therefore Subclassing them is not possible as opposed to Controls in VB which are true Windows each having a hwnd.
Surprisingly, Hooking the Mouse within XL doesn't cause any appearant problems !!! and did solve the problem :)
Below is the code :
' In a Standard Module (BAS)
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Type POINTAPI
X As Long
Y As Long
End Type
Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data
pt As POINTAPI
mouseData As Long ' Holds Forward\Bacward flag
flags As Long
time As Long
dwExtraInfo As Long
End Type
Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Dim hhkLowLevelMouse, lngInitialColor As Long
Dim udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
'=========================
'\\Copy the Data from lParam of the Hook Procedure argument to our Struct
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
GetHookStruct = udtlParamStuct
End Function
'=========================
Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Avoid XL crashing if RunTime error occurs due to Mouse fast movement
On Error Resume Next
' \\ Unhook & get out in case the application is deactivated
If GetForegroundWindow <> FindWindow("XLMAIN", Application.Caption) Then
Sheets("Sheet1").ComboBox1
UnHook_Mouse
Exit Function
End If
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\ Don't process Default WM_MOUSEWHEEL Window message
LowLevelMouseProc = True
'\\ Change Sheet&\DropDown names as required
With Sheets("Sheet1").ComboBox1
'\\ if rolling forward increase Top index by 1 to cause an Up Scroll
If GetHookStruct(lParam).mous
.TopIndex = intTopIndex - 1
'\\ Store new TopIndex value
intTopIndex = .TopIndex
Else '\\ if rolling backward decrease Top index by 1 to cause _
'\\a Down Scroll
.TopIndex = intTopIndex + 1
'\\ Store new TopIndex value
intTopIndex = .TopIndex
End If
End With
End If
Exit Function
End If
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
'=========================
Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub
'=========================
Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub
**************************
' Code In the WorkSheet Module where the ComBobox is placed.
Private Sub ComboBox1_GotFocus()
'Store the first TopIndex Value
intTopIndex = ComboBox1.TopIndex
Hook_Mouse
End Sub
Private Sub ComboBox1_LostFocus()
UnHook_Mouse
End Sub
I couldn't have done it without your help....Thank you very much Jarnsater.
Regards.
From msdn:
--------------------------
The high-order word of the wParam argument indicates the distance the wheel is rotated, expressed in multiples or divisions of WHEEL_DELTA, which is 120. A positive value indicates that the wheel was rotated forward, away from the user; a negative value indicates that the wheel was rotated backward, toward the user.
The low-order word indicates whether various virtual keys are down. This parameter can be one or more of the following values.
MK_CONTROL The CTRL key is down.
MK_LBUTTON The left mouse button is down.
MK_MBUTTON The middle mouse button is down.
MK_RBUTTON The right mouse button is down.
MK_SHIFT The SHIFT key is down.
MK_XBUTTON1 Windows 2000/XP: The first X button is down.
MK_XBUTTON2 Windows 2000/XP: The second X button is down.
--------------------------
Best regards / Jon