【VB6】鼠标滚轮支持模块

0xAA55

用法：调用EnableMouseWheel使特定控件支持滚轮消息。滚轮消息发生后，Ctrl.OnMouseWheelCallBack会被调用。
OnMouseWheelCallBack的参数列表必须是(ByVal hWnd As Long, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long)
你可以在一个Form窗体里写这个过程，就像这样：

1. Sub OnMouseWheelCallBack(ByVal hWnd As Long, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long)
   
2. If hWnd = 某控件.hWnd Then '判断是哪个控件发生了鼠标滚轮事件
   
3.     '处理滚轮消息
   
4.     'Delta是滚动值，通常为 120 或者 -120
   
5.     'X和Y是鼠标滚轮被搓动的时候，鼠标指针的坐标（相对于控件左上角）
   
6. End If
   
7. End Sub

复制代码

以下是这个模块的源码。顺带我想知道，我是把Ctrl定义为Object，并且调用了它的OnMouseWheelCallBack。不是所有的Object都有OnMouseWheelCallBack方法的，VB6是在编译的时候确定OnMouseWheelCallBack的地址还是在运行的时候确定OnMouseWheelCallBack的地址？求解答……

1. Option Explicit
   
2. 
   
3. Private Type CtrlWndProcData_t
   
4.     Ctrl As Object '被调用OnMouseWheelCallBack的对象
   
5.     hWnd As Long
   
6.     OldWndProc As Long '旧消息函数
   
7. End Type
   
8. 
   
9. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   
10. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
11. 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
    
12. Private Const GWL_WNDPROC = (-4)
    
13. Private Const WM_MOUSEWHEEL = &H20A
    
14. 
    
15. Private m_Ctrls() As CtrlWndProcData_t
    
16. Private m_NbCtrls As Long
    
17. Private m_MaxCtrls As Long
    
18. Private Const m_NbCtrlsAlloc As Long = 8
    
19. 
    
20. '启用特定控件、窗体对鼠标滚轮事件的支持
    
21. '调用后，如果发生了鼠标滚轮事件，Ctrl.OnMouseWheelCallBack会被调用。
    
22. 'OnMouseWheelCallBack的参数列表必须是(ByVal hWnd As Long, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long)
    
23. Sub EnableMouseWheel(Ctrl As Object, ByVal hWnd As Long)
    
24. Dim OldWndProc As Long
    
25. OldWndProc = GetWindowLong(hWnd, GWL_WNDPROC)
    
26. If OldWndProc = 0 Then Exit Sub
    
27. 
    
28. '“注册”hWnd的值到数组里
    
29. If m_NbCtrls >= m_MaxCtrls Then
    
30.     If m_MaxCtrls Then
    
31.         m_MaxCtrls = m_MaxCtrls + m_NbCtrlsAlloc
    
32.         ReDim Preserve m_Ctrls(m_MaxCtrls - 1)
    
33.     Else
    
34.         m_MaxCtrls = m_NbCtrlsAlloc
    
35.         ReDim m_Ctrls(m_MaxCtrls - 1)
    
36.     End If
    
37. End If
    
38. 
    
39. With m_Ctrls(m_NbCtrls)
    
40.     Set .Ctrl = Ctrl
    
41.     .hWnd = hWnd
    
42.     .OldWndProc = OldWndProc
    
43. End With
    
44. m_NbCtrls = m_NbCtrls + 1
    
45. 
    
46. 'Hook消息处理函数
    
47. SetWindowLong hWnd, GWL_WNDPROC, AddressOf ProcMouseWheel
    
48. End Sub
    
49. 
    
50. '控件、窗体被销毁前需要调用这个函数恢复旧的消息函数值
    
51. Sub DisableMouseWheel(ByVal hWnd As Long)
    
52. Dim I&
    
53. For I = 0 To m_NbCtrls - 1
    
54.     If m_Ctrls(I).hWnd = hWnd Then
    
55.         If m_Ctrls(I).OldWndProc Then SetWindowLong hWnd, GWL_WNDPROC, m_Ctrls(I).OldWndProc
    
56.         m_NbCtrls = m_NbCtrls - 1
    
57.         m_Ctrls(I) = m_Ctrls(m_NbCtrls)
    
58.         m_MaxCtrls = m_NbCtrls
    
59.         If m_MaxCtrls Then ReDim Preserve m_Ctrls(m_MaxCtrls - 1) Else Erase m_Ctrls
    
60.     End If
    
61. Next
    
62. End Sub
    
63. 
    
64. '窗口消息处理函数
    
65. Private Function ProcMouseWheel(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    
66. Dim I&
    
67. For I = 0 To m_NbCtrls - 1 '从“注册”了的hWnd里面找匹配的
    
68.     If m_Ctrls(I).hWnd = hWnd Then
    
69.         If Msg = WM_MOUSEWHEEL Then
    
70.             '找到后就调用OnMouseWheelCallBack方法
    
71.             m_Ctrls(I).Ctrl.OnMouseWheelCallBack hWnd, (wp And &HFFFF0000) \ &H10000, lp And &HFFFF&, (lp And &HFFFF0000) \ &H10000
    
72.         End If
    
73.         '用原有的消息处理函数去处理剩下的消息
    
74.         ProcMouseWheel = CallWindowProc(m_Ctrls(I).OldWndProc, hWnd, Msg, wp, lp)
    
75.     End If
    
76. Next
    
77. End Function

复制代码

乘简

支持啊。。。

Tao0Lu

做系统用的吧

大宝

鼠标滚轮的实际应用

liu496324

楼主威武，牛拜

gujin163

啥也不说了，帖子就是带劲！

gujin163

太谢谢老大的分享了。