【VB6】响应鼠标滚轮事件

0xAA55

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


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


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

3、是时候告诉大家原理了。其实也就是Hook消息处理函数，自己处理消息而已，非常简单的东西。
这里只是说一下大致的做法以便大家参考。
我们需要存储旧的消息处理函数的地址，来处理除了搓滚轮以外的消息（这样控件才能响应别的事件）。用GetWindowLong（第二个参数nIndex填GWL_WNDPROC）就可以获取旧的消息处理函数的地址了。
然后自己再写一个新的消息处理函数，用于处理搓滚轮消息。用SetWindowLong把这个新的消息处理函数安装进控件就行了。
API声明：

1. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
2. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
3. 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
   
4. Private Const GWL_WNDPROC = (-4)

复制代码

消息处理函数的原型必须是这样的：

1. 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和消息的处理过程，这里不能出错。

1. '这些代码必须放在Module模块里
   
2. '这些代码不是伪代码。。按照自己的需求修改后是可以使用的。
   
3. 
   
4. '首先声明API
   
5. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
6. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
7. 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
   
8. Private Const GWL_WNDPROC = (-4)
   
9. Private Const WM_MOUSEWHEEL As Long = &H20A&
   
10. Private Const WHEEL_DELTA = 120
    
11. 
    
12. '必须的变量
    
13. Dim 控件的hWnd As Long
    
14. Dim 控件的旧消息处理函数 As Long
    
15. 
    
16. '初始化操作。下面这个函数被调用后，控件才能识别鼠标滚轮。
    
17. Sub InitMouseWheel()
    
18. 控件的hWnd = 窗口.控件.hWnd
    
19. 控件的旧消息处理函数 = GetWindowLong(控件的hWnd, GWL_WNDPROC) '取得原先的消息处理函数的入口
    
20. SetWindowLong 控件的hWnd, GWL_WNDPROC, AddressOf 新消息处理函数 '安装自己的消息处理函数
    
21. End Sub
    
22. 
    
23. '消息处理函数，这个的参数类型和返回类型可不能写错了
    
24. Function 新消息处理函数(ByVal hWnd As Long, ByVal Msg As Long, ByVal WP As Long, ByVal LP As Long) As Long
    
25. If Msg = WM_MOUSEWHEEL Then '如果消息是“搓鼠标滚轮”
    
26.     If hWnd = 控件的hWnd Then '通过比较hWnd来判断是哪个控件或窗口被搓滚轮了
    
27.         Dim 滚动格数 As Long, 按键信息 As Long, X As Long, Y As Long
    
28.         滚动格数 = (WP And &HFFFF&) \ WHEEL_DELTA
    
29.         按键信息 = WP \ &H10000
    
30.         X = LP And &HFFFF& '搓滚轮的时候鼠标的位置
    
31.         Y = LP \ &H10000
    
32. 
    
33.         '做你的处理
    
34.     End If
    
35. Else '其它消息
    
36.     If hWnd = 控件的hWnd Then '判断是什么控件或窗口的消息，然后使用它们原先的消息处理函数来处理，使其能响应事件。
    
37.         新消息处理函数 = CallWindowProc(控件的旧消息处理函数, hWnd, Msg, WP, LP) '将参数原样传递给旧的消息处理函数，并且返回其返回的值。
    
38.     End If
    
39. End If
    
40. End Function

复制代码

乘简

此贴做废！~

11111111110x545

很好 很不错

7KY6

不错!!!!

大宝

响应鼠标滚轮事件

系统消息

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

xiawan

感谢楼主分享~~~

Golden Blonde

你这里应该是写错了：

1. 滚动格数 = (WP And &HFFFF&) \ WHEEL_DELTA
   
2. 按键信息 = WP \ &H10000

复制代码

跟你上图的代码不同。

0xAA55

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

没写错。