API mouse hook

F

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,645
Office Version
  1. 365
Platform
  1. Windows
I've been using the code below for many years without problems.
I have just installed Windows 11 and Office 365 and now the code does not work.
It produces a type mismatch error for the code highlighted in red (AddressOf MouseProc)
I know nothing about API code.
Would much appreciate help.
VBA Code: 
Sub HookListBoxScroll()
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
If mListBoxHwnd <> hwndUnderCursor Then
    UnhookListBoxScroll
    mListBoxHwnd = hwndUnderCursor
    lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
    PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
    If Not mbHook Then
        mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL,[COLOR=rgb(226, 80, 65)] AddressOf MouseProc[/COLOR], lngAppInst, 0)
        mbHook = mLngMouseHook <> 0
    End If
End If
End Sub
Sub UnhookListBoxScroll()
If mbHook Then
    UnhookWindowsHookEx mLngMouseHook
    mLngMouseHook = 0
    mListBoxHwnd = 0
    mbHook = False
End If
End Sub
Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
On Error GoTo errH    'Resume Next
If (nCode = HC_ACTION) Then
    If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
        If wParam = WM_MOUSEWHEEL Then
            MouseProc = True
            If lParam.hwnd > 0 Then
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
            Else
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
            End If
            PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
            Exit Function
        End If
    Else
        UnhookListBoxScroll
    End If
End If
MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function
 
Last edited:

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
Did you switch to 64 bit Office?
 
Upvote 0
No, you have clearly missed a few. All window handles and pointers should be LongPtr in 64 bit. The error indicates that your declaration for SetWindowsHookEx is wrong because AddressOf will return a LongPtr not a Long. It also looks like you didn't update WindowFromPoint since you have it returning a Long variable and again that should be a LongPtr. It should also be passing a LongLong, not two Longs, but you need an additional conversion function for that.
 
Upvote 0
RoryA said:
No, you have clearly missed a few. All window handles and pointers should be LongPtr in 64 bit. The error indicates that your declaration for SetWindowsHookEx is wrong because AddressOf will return a LongPtr not a Long. It also looks like you didn't update WindowFromPoint since you have it returning a Long variable and again that should be a LongPtr. It should also be passing a LongLong, not two Longs, but you need an additional conversion function for that.
Click to expand...
Thanks for advice and input.
Unfortunately, I have no idea what should be changed into what.
I'll just have to do without it - pity since it was really useful.

Should all Long's be corrected to LongPtr ?
 
Upvote 0
footoo said:
Should all Long's be corrected to LongPtr ?
Click to expand...
No, absolutely not.

If you post the declarations you are using, I'm sure someone can update them as well as this code.
 
Upvote 0
RoryA said:
No, absolutely not.

If you post the declarations you are using, I'm sure someone can update them as well as this code.
Click to expand...
There's a lot of code. Would be most grateful to anyone who can help.

VBA Code: 
'Needed for the 'Always On Top' code in the Open_UserForms macros

Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1

Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Declare PtrSafe Function SetWindowPos Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal uFlags As Long) As Long

Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

VBA Code: 
Private Type POINTAPI
     x As Long
     y As Long
End Type

Private Type MOUSEHOOKSTRUCT
     pt As POINTAPI
     hwnd As Long
     wHitTestCode As Long
     dwExtraInfo As Long
End Type

Private Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
    Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long

Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
    ByVal hHook As Long, _
    ByVal nCode As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
    ByVal hHook As Long) As Long

Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
    Alias "PostMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
    ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long

Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean
Sub HookListBoxScroll()
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
If mListBoxHwnd <> hwndUnderCursor Then
    UnhookListBoxScroll
    mListBoxHwnd = hwndUnderCursor
    lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
    PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
    If Not mbHook Then
        mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
        mbHook = mLngMouseHook <> 0
    End If
End If
End Sub
Sub UnhookListBoxScroll()
If mbHook Then
    UnhookWindowsHookEx mLngMouseHook
    mLngMouseHook = 0
    mListBoxHwnd = 0
    mbHook = False
End If
End Sub
Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
On Error GoTo errH    'Resume Next
If (nCode = HC_ACTION) Then
    If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
        If wParam = WM_MOUSEWHEEL Then
            MouseProc = True
            If lParam.hwnd > 0 Then
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
            Else
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
            End If
            PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
            Exit Function
        End If
    Else
        UnhookListBoxScroll
    End If
End If
MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function

VBA Code: 
Private Type POINTAPI
   x                               As Long
   y                               As Long
End Type
Private Type MOUSEHOOKSTRUCT
   pt                              As POINTAPI
   hwnd                            As Long
   wHitTestCode                    As Long
   dwExtraInfo                     As Long
End Type

Private Declare PtrSafe Function FindWindow Lib "user32" _
                                    Alias "FindWindowA" ( _
                                    ByVal lpClassName As String, _
                                    ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                                       Alias "GetWindowLongA" ( _
                                       ByVal hwnd As Long, _
                                       ByVal nIndex As Long) As Long

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                          Alias "SetWindowsHookExA" ( _
                                          ByVal idHook As Long, _
                                          ByVal lpfn As Long, _
                                          ByVal hmod As Long, _
                                          ByVal dwThreadId As Long) As Long

Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                        ByVal hHook As Long, _
                                        ByVal nCode As Long, _
                                        ByVal wParam As Long, _
                                        lParam As Any) As Long

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                             ByVal hHook As Long) As Long

Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
                                     Alias "PostMessageA" ( _
                                     ByVal hwnd As Long, _
                                     ByVal wMsg As Long, _
                                     ByVal wParam As Long, _
                                     ByVal lParam As Long) As Long

Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                         ByVal xPoint As Long, _
                                         ByVal yPoint As Long) As Long

Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
                                      ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL          As Long = 14
Private Const WM_MOUSEWHEEL        As Long = &H20A
Private Const HC_ACTION            As Long = 0
Private Const GWL_HINSTANCE        As Long = (-6)

Private Const WM_KEYDOWN           As Long = &H100
Private Const WM_KEYUP             As Long = &H101
Private Const VK_UP                As Long = &H26
Private Const VK_DOWN              As Long = &H28
Private Const WM_LBUTTONDOWN       As Long = &H201

Private Const cSCROLLCHANGE        As Long = 10

Private mLngMouseHook              As Long
Private mFormHwnd                  As Long
Private mbHook                     As Boolean
Dim mForm                          As Object

Sub HookFormScroll(oForm As Object)
   Dim lngAppInst                  As Long
   Dim hwndUnderCursor             As Long

   Set mForm = oForm
   hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
Debug.Print "Form window: " & hwndUnderCursor
   If mFormHwnd <> hwndUnderCursor Then
      UnhookFormScroll
Debug.Print "Unhook old proc"
      mFormHwnd = hwndUnderCursor
      lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
      If Not mbHook Then
         mLngMouseHook = SetWindowsHookEx( _
                         WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
         mbHook = mLngMouseHook <> 0
         If mbHook Then Debug.Print "Form hooked"
      End If
   End If
End Sub

Sub UnhookFormScroll()
   If mbHook Then
      UnhookWindowsHookEx mLngMouseHook
      mLngMouseHook = 0
      mFormHwnd = 0
      mbHook = False
   End If
End Sub

Private Function MouseProc( _
        ByVal nCode As Long, ByVal wParam As Long, _
        ByRef lParam As MOUSEHOOKSTRUCT) As Long
   On Error GoTo errH   'Resume Next
   If (nCode = HC_ACTION) Then
Debug.Print "action"
Debug.Print "right window"
      If wParam = WM_MOUSEWHEEL Then
Debug.Print "mouse scroll"
         MouseProc = True
         If lParam.hwnd > 0 Then
            mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
         Else
            mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
         End If
         Exit Function
      End If
   End If
   MouseProc = CallNextHookEx( _
               mLngMouseHook, nCode, wParam, ByVal lParam)
   Exit Function
errH:
   UnhookFormScroll
End Function

VBA Code: 
Sub Personal_Macros()

'Make always on top
Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"
Dim ret#, formHWnd#
'Get window handle of the userform
formHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, PersonalMacros.Caption)
'Set userform window to 'always on top'
ret = SetWindowPos(formHWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Sub
 
Upvote 0
Yikes. ;) Pretty much all of those declarations are wrong. All the window handles and pointers (anything with hwnd for example) should be LongPtr not Long.

I'm going to be away for the next week or so, so I won't have time to look at it but perhaps someone else will (@Jaafar Tribak ;)). You might also search the forum for 64 bit scroll as I know this has come up before.
 
Upvote 0
RoryA said:
Yikes. ;) Pretty much all of those declarations are wrong. All the window handles and pointers (anything with hwnd for example) should be LongPtr not Long.

I'm going to be away for the next week or so, so I won't have time to look at it but perhaps someone else will (@Jaafar Tribak ;)). You might also search the forum for 64 bit scroll as I know this has come up before.
Click to expand...
I managed to cobble something together from the internet, so now it's working.
Thanks for the help.
 
Upvote 0
OK, i am resurrecting this now as I am having the same issue wit virtually the same code: dies on this line - lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
Option Explicit
' Code from Peter Thornton here:
' Mouse scroll in UserForm ListBox in Excel 2010
Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As LongPtr
wHitTestCode As Long
dwExtraInfo As Long
End Type

Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As LongPtr
'changed from sting to as any above

Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As LongPtr

Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As LongPtr

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As LongPtr

Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As LongPtr

Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As LongPtr

Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As LongPtr

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As LongPtr
Private mListBoxHwnd As LongPtr

Private mbHook As Boolean

Sub HookListBoxScroll()
Dim lngAppInst As Long
Dim hwndUnderCursor As LongPtr
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
If mListBoxHwnd <> hwndUnderCursor Then
UnhookListBoxScroll
mListBoxHwnd = hwndUnderCursor
lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
If Not mbHook Then
mLngMouseHook = SetWindowsHookEx( _
WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
mbHook = mLngMouseHook <> 0
End If
End If
End Sub

Sub UnhookListBoxScroll()
If mbHook Then
UnhookWindowsHookEx mLngMouseHook
mLngMouseHook = 0
mListBoxHwnd = 0
mbHook = False
End If
End Sub

Private Function MouseProc( _
ByVal nCode As Long, ByVal wParam As Long, _
ByRef lParam As MOUSEHOOKSTRUCT) As Long
On Error GoTo errH 'Resume Next
If (nCode = HC_ACTION) Then
If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
If wParam = WM_MOUSEWHEEL Then
MouseProc = True
If lParam.hwnd > 0 Then
PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
Else
PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
End If
PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
Exit Function
End If
Else
UnhookListBoxScroll
End If
End If
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
MouseScroll in UserForm ComboBox/ListBox
Replies
0
Views
2K
d365b
D
Jaafar Tribak
  • Question Question
KeyPress Event for Worksheet Cells (Subclassing Without Crashing)
Replies
1
Views
396
Bib195
B
A
  • Question Question
What is wrong with this VBA code: userForm get hand ico for pointer on hover
2
Replies
15
Views
1K
RoryA
RoryA
Jaafar Tribak
  • Question Question
Capturing the Paste Event (API Hooking - Redirection)
Replies
4
Views
861
Jaafar Tribak
Jaafar Tribak
H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
789
huiettcm
H

Forum statistics

Threads
1,224,825
Messages
6,181,190
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top