鼠标滚轮

Public Const GWL_WNDPROC = (-4)
    Public Const WM_COMMAND = &H111
    Public Const WM_MBUTTONDOWN = &H207
    Public Const WM_MBUTTONUP = &H208
    Public Const WM_MOUSEWHEEL = &H20A
   
    Public Oldwinproc As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _
                            ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
    Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                            ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                            ByVal nIndex As Long) As Long
Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'支持滚轮的滚动 Yu 2004-5-10 15:33
    Select Case wMsg
    Case WM_MOUSEWHEEL
        Select Case wParam
        Case -7864320  '向下滚
            SendKeys "{PGDN}"
        Case 7864320   '向上滚
            SendKeys "{PGUP}"
        End Select
                
    End Select
    FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam)
End Function
'支持滚轮鼠标API---------------------------------

'将下列代码写到表格控件的GotFocus事件中
Private Sub 控件名称_GotFocus()
    Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
End Sub

'将下列代码写到表格控件的LostFocus事件中
Private Sub 控件名称_LostFocus()
    SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
End Sub