让VB的应用程序，让VB的控件支持鼠标滚轮

让VB的应用程序，让VB的控件支持鼠标滚轮

VB6.0本身，以及VB做出来的程序都不支持鼠标滚轮，以前鼠标一般是两键，但现在基本上是三键鼠标，即有一个中键，有滚轮，如果应用程序不支持鼠标滚轮，这在用户的体验上就没有那么好了，操作上也不方便，还好有高手做了相应的代码解决此事，只要新建一个标准模块（.bas)，然后在窗体上加两个事件代码就行了。

标准模块代码如下：
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

在窗体模块上的代码如下：
Private Sub MfgMonth_GotFocus()
    Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
End Sub

Private Sub MfgMonth_LostFocus()
    SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
End Sub

--------------------------
你可以试验一下，在窗体上建一个文件框控件，文件框的MultiLine的属性设置为True，ScrollBars属性设置为2，启动后，你往文本框中输入或复制粘贴足够多的字符，当文本框的滚动条出现时，你可以试试鼠标的滚轮，滚轮肯定可以使用了。

打赏 支付宝打赏 微信打赏

来源：济亨网

本文链接：https://wb98.com/post/166.html