当前位置:首页 » 程序代码 » 正文

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

2017-06-04 21:54:06  分类: 程序代码  参与:

让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,启动后,你往文本框中输入或复制粘贴足够多的字符,当文本框的滚动条出现时,你可以试试鼠标的滚轮,滚轮肯定可以使用了。

来源:济亨网

本文链接:http://www.wb98.com/post/166.html

本站文章搜索:

<< 上一篇下一篇 >>

文章搜索

Tags列表

跟你相关

湘公网安备 43011102000514号 - ICP备08100508号