Tweet
[COLOR=Green]'''''' normal module code[/COLOR]
[COLOR=Blue]Option[/COLOR] [COLOR=Blue]Explicit[/COLOR]
[COLOR=Blue]Private[/COLOR] Type POINTAPI
X [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
Y [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]End[/COLOR] Type
[COLOR=Blue]Private[/COLOR] Type MOUSEHOOKSTRUCT
pt [COLOR=Blue]As[/COLOR] POINTAPI
hwnd [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
wHitTestCode [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
dwExtraInfo [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]End[/COLOR] Type
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] FindWindow [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32"[/COLOR] _
[COLOR=Blue]Alias[/COLOR] [COLOR=#A31515]"FindWindowA"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] lpClassName [COLOR=Blue]As[/COLOR] [COLOR=Blue]String[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] lpWindowName [COLOR=Blue]As[/COLOR] [COLOR=Blue]String[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] GetWindowLong [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32.dll"[/COLOR] _
[COLOR=Blue]Alias[/COLOR] [COLOR=#A31515]"GetWindowLongA"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] hwnd [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] nIndex [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] SetWindowsHookEx [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32"[/COLOR] _
[COLOR=Blue]Alias[/COLOR] [COLOR=#A31515]"SetWindowsHookExA"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] idHook [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] lpfn [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] hmod [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] dwThreadId [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] CallNextHookEx [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] hHook [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] nCode [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] wParam [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
lParam [COLOR=Blue]As[/COLOR] [COLOR=Blue]Any[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] UnhookWindowsHookEx [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] hHook [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Green]'Private Declare Function PostMessage Lib "user32.dll" _[/COLOR]
[COLOR=Green]' Alias "PostMessageA" ( _[/COLOR]
[COLOR=Green]' ByVal hwnd As Long, _[/COLOR]
[COLOR=Green]' ByVal wMsg As Long, _[/COLOR]
[COLOR=Green]' ByVal wParam As Long, _[/COLOR]
[COLOR=Green]' ByVal lParam As Long) As Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] WindowFromPoint [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32"[/COLOR] ( _
[COLOR=Blue]ByVal[/COLOR] xPoint [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] yPoint [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Declare[/COLOR] [COLOR=Blue]Function[/COLOR] GetCursorPos [COLOR=Blue]Lib[/COLOR] [COLOR=#A31515]"user32.dll"[/COLOR] ( _
[COLOR=Blue]ByRef[/COLOR] lpPoint [COLOR=Blue]As[/COLOR] POINTAPI) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Const[/COLOR] WH_MOUSE_LL [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR] = 14
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Const[/COLOR] WM_MOUSEWHEEL [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR] = &H20A
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Const[/COLOR] HC_ACTION [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR] = 0
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Const[/COLOR] GWL_HINSTANCE [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR] = (-6)
[COLOR=Green]'Private Const WM_KEYDOWN As Long = &H100[/COLOR]
[COLOR=Green]'Private Const WM_KEYUP As Long = &H101[/COLOR]
[COLOR=Green]'Private Const VK_UP As Long = &H26[/COLOR]
[COLOR=Green]'Private Const VK_DOWN As Long = &H28[/COLOR]
[COLOR=Green]'Private Const WM_LBUTTONDOWN As Long = &H201[/COLOR]
[COLOR=Blue]Private[/COLOR] mLngMouseHook [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] mListBoxHwnd [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Private[/COLOR] mbHook [COLOR=Blue]As[/COLOR] [COLOR=Blue]Boolean[/COLOR]
[COLOR=Blue]Private[/COLOR] mCtl [COLOR=Blue]As[/COLOR] MSForms.Control
[COLOR=Blue]Dim[/COLOR] n [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Sub[/COLOR] HookListBoxScroll(frm [COLOR=Blue]As[/COLOR] [COLOR=Blue]Object[/COLOR], ctl [COLOR=Blue]As[/COLOR] MSForms.Control)
[COLOR=Blue]Dim[/COLOR] lngAppInst [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Dim[/COLOR] hwndUnderCursor [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Dim[/COLOR] tPT [COLOR=Blue]As[/COLOR] POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
[COLOR=Blue]If[/COLOR] [COLOR=Blue]Not[/COLOR] frm.ActiveControl [COLOR=Blue]Is[/COLOR] ctl [COLOR=Blue]Then[/COLOR]
ctl.SetFocus
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]If[/COLOR] mListBoxHwnd <> hwndUnderCursor [COLOR=Blue]Then[/COLOR]
UnhookListBoxScroll
[COLOR=Blue]Set[/COLOR] mCtl = ctl
mListBoxHwnd = hwndUnderCursor
lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
[COLOR=Green]' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&[/COLOR]
[COLOR=Blue]If[/COLOR] [COLOR=Blue]Not[/COLOR] mbHook [COLOR=Blue]Then[/COLOR]
mLngMouseHook = SetWindowsHookEx( _
WH_MOUSE_LL, [COLOR=Blue]AddressOf[/COLOR] MouseProc, lngAppInst, 0)
mbHook = mLngMouseHook <> 0
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
[COLOR=Blue]Sub[/COLOR] UnhookListBoxScroll()
[COLOR=Blue]If[/COLOR] mbHook [COLOR=Blue]Then[/COLOR]
[COLOR=Blue]Set[/COLOR] mCtl = [COLOR=Blue]Nothing[/COLOR]
UnhookWindowsHookEx mLngMouseHook
mLngMouseHook = 0
mListBoxHwnd = 0
mbHook = [COLOR=Blue]False[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Function[/COLOR] MouseProc( _
[COLOR=Blue]ByVal[/COLOR] nCode [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], [COLOR=Blue]ByVal[/COLOR] wParam [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR], _
[COLOR=Blue]ByRef[/COLOR] lParam [COLOR=Blue]As[/COLOR] MOUSEHOOKSTRUCT) [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Dim[/COLOR] idx [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]On[/COLOR] [COLOR=Blue]Error[/COLOR] [COLOR=Blue]GoTo[/COLOR] errH
[COLOR=Blue]If[/COLOR] (nCode = HC_ACTION) [COLOR=Blue]Then[/COLOR]
[COLOR=Blue]If[/COLOR] WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd [COLOR=Blue]Then[/COLOR]
[COLOR=Blue]If[/COLOR] wParam = WM_MOUSEWHEEL [COLOR=Blue]Then[/COLOR]
MouseProc = [COLOR=Blue]True[/COLOR]
[COLOR=Green]' If lParam.hwnd > 0 Then[/COLOR]
[COLOR=Green]' PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0[/COLOR]
[COLOR=Green]' Else[/COLOR]
[COLOR=Green]' PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0[/COLOR]
[COLOR=Green]' End If[/COLOR]
[COLOR=Green]' PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0[/COLOR]
[COLOR=Blue]If[/COLOR] lParam.hwnd > 0 [COLOR=Blue]Then[/COLOR] idx = -1 [COLOR=Blue]Else[/COLOR] idx = 1
idx = idx + mCtl.ListIndex
[COLOR=Blue]If[/COLOR] idx >= 0 [COLOR=Blue]Then[/COLOR] mCtl.ListIndex = idx
[COLOR=Blue]Exit[/COLOR] [COLOR=Blue]Function[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]Else[/COLOR]
UnhookListBoxScroll
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]If[/COLOR]
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, [COLOR=Blue]ByVal[/COLOR] lParam)
[COLOR=Blue]Exit[/COLOR] [COLOR=Blue]Function[/COLOR]
errH:
UnhookListBoxScroll
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Function[/COLOR]
[COLOR=Green]'''''''' end normal module code[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Sub[/COLOR] comboBox1_MouseMove( _
[COLOR=Blue]ByVal[/COLOR] Button [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR], [COLOR=Blue]ByVal[/COLOR] Shift [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] X [COLOR=Blue]As[/COLOR] [COLOR=Blue]Single[/COLOR], [COLOR=Blue]ByVal[/COLOR] Y [COLOR=Blue]As[/COLOR] [COLOR=Blue]Single[/COLOR])
HookListBoxScroll [COLOR=Blue]Me[/COLOR], [COLOR=Blue]Me[/COLOR].ComboBox1
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Sub[/COLOR] ListBox1_MouseMove( _
[COLOR=Blue]ByVal[/COLOR] Button [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR], [COLOR=Blue]ByVal[/COLOR] Shift [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR], _
[COLOR=Blue]ByVal[/COLOR] X [COLOR=Blue]As[/COLOR] [COLOR=Blue]Single[/COLOR], [COLOR=Blue]ByVal[/COLOR] Y [COLOR=Blue]As[/COLOR] [COLOR=Blue]Single[/COLOR])
HookListBoxScroll [COLOR=Blue]Me[/COLOR], [COLOR=Blue]Me[/COLOR].ListBox1
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Sub[/COLOR] UserForm_Initialize()
[COLOR=Blue]Dim[/COLOR] i [COLOR=Blue]As[/COLOR] [COLOR=Blue]Long[/COLOR]
[COLOR=Blue]Dim[/COLOR] s [COLOR=Blue]As[/COLOR] [COLOR=Blue]String[/COLOR]
s = [COLOR=#A31515]"this is line "[/COLOR]
[COLOR=Blue]For[/COLOR] i = 1 [COLOR=Blue]To[/COLOR] 50
[COLOR=Blue]Me[/COLOR].ComboBox1.AddItem s & i
[COLOR=Blue]Me[/COLOR].ListBox1.AddItem s & i
[COLOR=Blue]Next[/COLOR]
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
[COLOR=Blue]Private[/COLOR] [COLOR=Blue]Sub[/COLOR] UserForm_QueryClose(Cancel [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR], CloseMode [COLOR=Blue]As[/COLOR] [COLOR=Blue]Integer[/COLOR])
UnhookListBoxScroll
[COLOR=Blue]End[/COLOR] [COLOR=Blue]Sub[/COLOR]
کامنت