VB6中鼠标滚轮的使用

VB6并不支持鼠标滚轮的处理，所以要借助系统的API钩子函数来实现。代码如下。 
使用方法：工程中添加一个模块，添加下述代码。使用时在主窗口中调用一次 HOOK 函数安装钩子即可。程序退出时不要忘记使用 UNHOOK 函数卸载安装的钩子，否则会造成系统的资源浪费。 
在下述 WindowProc 函数中注释的地方加入自己的代码，就可完成鼠标滚轮事件的处理了。 


Option Explicit 
Public Type POINTL 
X As Long 
Y As Long 
End Type 
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 
Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 
Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, xyPoint As POINTL) As Long
 
Public Const GWL_WNDPROC = -4 
Public Const SPI_GETWHEELSCROLLLINES = 104 
Public Const WM_MOUSEWHEEL = &H20A 
Public WHEEL_SCROLL_LINES As Long
 

Global lpPrevWndProc As Long 
Public sngX As Single, sngY As Single   '鼠标坐标 
Public intShift As Integer              '鼠标按键 
Public bWay As Boolean                  '鼠标方向 
Public bMouseFlag As Boolean            '鼠标事件激活标志
 
'************************************************************************* 
'**函 数 名：Hook 
'**输    入：ByVal hWnd(Long) - 窗口句柄 
'**输    出：无 
'**功能描述：安装鼠标钩子 
'************************************************************************* 
Public Sub Hook(ByVal hWnd As Long) 
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) 
    '获取"控制面板"中的滚动行数值 
    Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0) 
End Sub
 
'************************************************************************* 
'**函 数 名：UnHook 
'**输    入：ByVal hWnd(Long) - 窗口句柄 
'**输    出：无 
'**功能描述：卸载鼠标钩子 
'************************************************************************* 
Public Sub UnHook(ByVal hWnd As Long) 
    Dim lngReturnValue As Long 
    lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc) 
End Sub
 
'************************************************************************* 
'**函 数 名：WindowProc 
'**输    入：ByVal hw(Long)     - 窗口句柄 
'**        ：ByVal uMsg(Long)   - 消息类型 
'**        ：ByVal wParam(Long) - 
'**        ：ByVal lParam(Long) - 
'************************************************************************* 
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    Dim pt As POINTL 
    Select Case uMsg 
        Case WM_MOUSEWHEEL   '滚动 
            Dim wzDelta, wKeys As Integer 
             
            'wzDelta传递滚轮滚动的快慢，该值小于零表示滚轮向后滚动（朝用户方向）， 
            '大于零表示滚轮向前滚动（朝显示器方向） 
            wzDelta = HIWORD(wParam) 
             
            'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下，允许复合 
            wKeys = LOWORD(wParam) 
             
            'pt鼠标的坐标 
            pt.X = LOWORD(lParam) 
            pt.Y = HIWORD(lParam) 
             
            '-------------------------------------------------- 
             If wzDelta < 0 Then  '朝用户方向 
                bWay = True 
                '在这里你自己处理－－－－－－－－－－－－－－－－－－
 
                MsgBox 0       '这行代码由我加入，使用时改为你自己的代码
             Else                 '朝显示器方向 
                bWay = False 
                MsgBox 1        '这行代码由我加入，使用时改为你自己的代码
             End If 
            '-------------------------------------------------- 
            '将屏幕坐标转换为Form1.窗口坐标 
             ScreenToClient hw, pt 
             sngX = pt.X 
             sngY = pt.Y 
             intShift = wKeys 
             
             bMouseFlag = True  '置滚动标志 
        Case Else 
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) 
    End Select 
End Function
 
'************************************************************************* 
'**函 数 名：HIWORD 
'**输    入：LongIn(Long) - 32位值 
'**输    出：(Integer) - 32位值的低16位 
'**功能描述：取出32位值的高16位 
'************************************************************************* 
Public Function HIWORD(LongIn As Long) As Integer 
   ' 取出32位值的高16位 
     HIWORD = (LongIn And &HFFFF0000) \ &H10000 
End Function
 
'************************************************************************* 
'**函 数 名：LOWORD 
'**输    入：LongIn(Long) - 32位值 
'**输    出：(Integer) - 32位值的低16位 
'**功能描述：取出32位值的低16位 
'************************************************************************* 
Public Function LOWORD(LongIn As Long) As Integer 
   ' 取出32位值的低16位 
     LOWORD = LongIn And &HFFFF& 
End Function