001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126 |
|
Option Explicit
Private Type POINTAPI
XY As Currency
End Type
Private Type MOUSEHOOKSTRUCT
Pt As POINTAPI
hwnd As LongPtr
wHitTestCode As LongPtr
dwExtraInfo As LongPtr
End Type
Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" _
Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As LongPtr, _
ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, _
ByVal dwThreadId As LongPtr) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
ByVal hHook As LongPtr, _
ByVal nCode As LongPtr, _
ByVal wParam As LongPtr, _
lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As LongPtr) As LongPtr
Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" ( _
ByVal hwnd As LongPtr, _
ByVal wMsg As LongPtr, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
ByVal Point As Currency) 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 LongPtr
Dim hwndUnderCursor As LongPtr
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.XY)
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 LongPtr, ByVal wParam As LongPtr, _
ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
On Error GoTo errH ' Resume Next
If (nCode = HC_ACTION) Then
If WindowFromPoint(lParam.Pt.XY) = 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
|