论坛 › 技巧探讨 › 【VB6】响应鼠标滚轮事件

0xAA55 发表于 2015-11-30 20:25:13

【VB6】响应鼠标滚轮事件

VB6的窗体或PictureBox本来只支持鼠标的三个操作：按下鼠标键，移动鼠标，松开鼠标键。然而对于习惯了搓鼠标滚轮的用户来说，如果能搓鼠标滚轮就更爽了。
这里不放出完整的App了。我就说个方法，大家脑补一下写写代码就可以搞定了。
1、给工程新建一个模块（module）


2、你需要哪个控件（或窗口）响应鼠标滚轮事件呢？选好，然后用一个变量来存储它的hWnd的值。
就像我这样，把它写得漂漂亮亮的。


之所以这么做（而不是使用picTileList.hWnd）是有理由的。当窗口被卸载的时候，在VB里“picTileList”这个控件类也就被卸载了。然而这个时候你还会收到消息。这个时候，“picTileList”这个控件类就无法被使用了（因此你也不能获取其hWnd）

3、是时候告诉大家原理了。其实也就是Hook消息处理函数，自己处理消息而已，非常简单的东西。
这里只是说一下大致的做法以便大家参考。
我们需要存储旧的消息处理函数的地址，来处理除了搓滚轮以外的消息（这样控件才能响应别的事件）。用GetWindowLong（第二个参数nIndex填GWL_WNDPROC）就可以获取旧的消息处理函数的地址了。
然后自己再写一个新的消息处理函数，用于处理搓滚轮消息。用SetWindowLong把这个新的消息处理函数安装进控件就行了。
API声明：Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC = (-4)消息处理函数的原型必须是这样的：Private Function MouseWheelProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal WP As Long, ByVal LP As Long) As Long其实只要有四个ByVal的Long参数，并且最后返回Long就行了。函数名、是不是Private等这些可以根据自己的喜好来设置。


4、消息处理函数的内容。
分三步。首先判断消息（也就是第二个参数）是不是WM_MOUSEWHEEL（值为&H20A），其次判断窗口句柄（第一个消息）是哪个控件的句柄。根据这个来判断是你的哪个控件（或窗口）被搓了鼠标滚轮。
如果消息不是WM_MOUSEWHEEL，那就用CallWindowProc来调用旧的消息处理函数（并且把你的四个参数也传递进去）


5、给你的控件写搓滚轮事件处理过程吧！
为了使其更符合VB的风格，我是这样写的。

其中的Delta是手搓滚轮的格数（滚轮是一格一格的，你每搓一格都会有个感觉的，不过有的鼠标没有这种感觉）乘以WHEEL_DELTA（也就是120），因此你需要让Delta的值除以WHEEL_DELTA来取得实际的格数。
啊，忘了。你的窗口刚加载的时候就得完成Hook操作。。不Hook就不能识别。因此，在窗口加载的时候，完成操作吧。


觉得有点乱哈。凑合着看看吧。提示一下重点是消息处理函数的Hook和消息的处理过程，这里不能出错。'这些代码必须放在Module模块里
'这些代码不是伪代码。。按照自己的需求修改后是可以使用的。

'首先声明API
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A&
Private Const WHEEL_DELTA = 120

'必须的变量
Dim 控件的hWnd As Long
Dim 控件的旧消息处理函数 As Long

'初始化操作。下面这个函数被调用后，控件才能识别鼠标滚轮。
Sub InitMouseWheel()
控件的hWnd = 窗口.控件.hWnd
控件的旧消息处理函数 = GetWindowLong(控件的hWnd, GWL_WNDPROC) '取得原先的消息处理函数的入口
SetWindowLong 控件的hWnd, GWL_WNDPROC, AddressOf 新消息处理函数 '安装自己的消息处理函数
End Sub

'消息处理函数，这个的参数类型和返回类型可不能写错了
Function 新消息处理函数(ByVal hWnd As Long, ByVal Msg As Long, ByVal WP As Long, ByVal LP As Long) As Long
If Msg = WM_MOUSEWHEEL Then '如果消息是“搓鼠标滚轮”
    If hWnd = 控件的hWnd Then '通过比较hWnd来判断是哪个控件或窗口被搓滚轮了
      Dim 滚动格数 As Long, 按键信息 As Long, X As Long, Y As Long
      滚动格数 = (WP And &HFFFF&) \ WHEEL_DELTA
      按键信息 = WP \ &H10000
      X = LP And &HFFFF& '搓滚轮的时候鼠标的位置
      Y = LP \ &H10000

      '做你的处理
    End If
Else '其它消息
    If hWnd = 控件的hWnd Then '判断是什么控件或窗口的消息，然后使用它们原先的消息处理函数来处理，使其能响应事件。
      新消息处理函数 = CallWindowProc(控件的旧消息处理函数, hWnd, Msg, WP, LP) '将参数原样传递给旧的消息处理函数，并且返回其返回的值。
    End If
End If
End Function

乘简 发表于 2017-12-22 12:06:49

本帖最后由 乘简 于 2017-12-25 16:09 编辑

此贴做废！~

11111111110x545 发表于 2017-12-24 18:50:17

很好 很不错

7KY6 发表于 2018-1-14 12:58:11

不错!!!!

大宝 发表于 2020-7-8 10:47:57

响应鼠标滚轮事件

系统消息 发表于 2020-7-8 22:44:15

A5大婶居然都没有水平滚轮支持

xiawan 发表于 2022-5-9 09:24:49

感谢楼主分享~~~

Golden Blonde 发表于 2022-8-12 05:29:10

你这里应该是写错了：滚动格数 = (WP And &HFFFF&) \ WHEEL_DELTA
按键信息 = WP \ &H10000跟你上图的代码不同。

0xAA55 发表于 2022-8-12 10:42:38

Golden Blonde 发表于 2022-8-12 05:29
你这里应该是写错了：跟你上图的代码不同。

没写错。

查看完整版本: 【VB6】响应鼠标滚轮事件