麻辣家族討論版版 - Powered by Discuz! Board

Private Sub UserForm_Activate()
ComboBox1.Value = "150"
ComboBox1.List = Array("150", "200", "250", "300", "350", "400", "450", "500", "510", "570", "630", _
"700", "770", "840", "920", "1000", "1080", "1170", "1270", "1370", "1480", "1600", "1720", "1850", "2000", _
"2150", "2320", "2500", "2700", "2900", "3150", "3400", "3700", "4000", "4400", "4800", "5300", "5800", _
"6400", "7000", "7700", "8500", "9500", "10500", "12000", "13500")
End Sub
Sub ComboBox1_DropButton()
'Store the first TopIndex Value
intTopIndex = ComboBox1.TopIndex
Hook_Mouse
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
UnHook_Mouse
End Sub

複製代碼

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
Private Sub Auto_open()
UserForm1.ComboBox1_DropButton
UserForm1.Show
End Sub
' ==========================================================================
' \\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
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\ Don't process Default WM_MOUSEWHEEL Window message
LowLevelMouseProc = True
' \\ Change this to your userform name
With UserForm1.ComboBox1
' \\ if rolling forward increase Top index by 1 to cause an Up Scroll
If GetHookStruct(lParam).mouseData > 0 Then
.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

複製代碼

Private Sub Auto_Close()
UnHook_Mouse
End Sub

複製代碼

Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

複製代碼

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

複製代碼