鼠标滚轮

支持滚轮滚动的函数实现

最新推荐文章于 2014-09-09 13:50:19 发布

原创最新推荐文章于 2014-09-09 13:50:19 发布 · 1.2k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#function #user #command

1.6学习笔记专栏收录该内容

53 篇文章

订阅专栏

博客展示了支持滚轮滚动的代码实现。定义了多个常量，声明了多个Windows API函数，如SetWindowLong、CallWindowProc等。通过FlexScroll函数处理鼠标滚轮消息，根据滚轮方向发送相应按键。还给出了表格控件获取和失去焦点时的代码处理。

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