大家好! 怎麼使 vb6.0 支持鼠標的滾軸滑動?

前一阵买了个鼠标(有一个滚轮的), 发现有许多程序不支持, 
包括偶自己写的程序.  
今天心血来潮, 编了一段小程序来接收鼠标滚轮滚动的消息. 
 
PS: 4D的鼠标偶没用过, 不知道如何分别区分两个滚轮来的消息? 
 
Form1.frm 
'Form1上放一个滚动条VScroll1 
 
Private Sub Form_Load() 
gHW = Me.hwnd 
Hook 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
Unhook 
End Sub 
 
'========================= 
Module1.bas 
 
Option Explicit 
 
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 
 
 
Public Const WM_MOUSEWHEEL = &H20A 
Public Const GWL_WNDPROC = -4 
Global lpPrevWndProc As Long 
Global gHW As Long 
 
 
Public Sub Hook() 
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc) 
End Sub 
    
Public Sub Unhook() 
   Dim temp As Long 
   temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) 
End Sub 
 
 
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _ 
                    ByVal wParam As Long, ByVal lParam As Long) As Long 
   If uMsg = WM_MOUSEWHEEL Then 
    ProcMouseWheel wParam, lParam 
       Else 
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) 
   End If 
End Function 
 
Public Sub ProcMouseWheel(wParam As Long, lParam As Long) 
'WM_MOUSEWHEEL 
'fwKeys = LOWORD(wParam);    // key flags 
'zDelta = (short) HIWORD(wParam);    // wheel rotation 
'xPos = (short) LOWORD(lParam);    // horizontal position of pointer 
'yPos = (short) HIWORD(lParam);    // vertical position of pointer 
' 
'Parameters 
'fwKeys 
'Value of the low-order word of wParam. Indicates whether various virtual 
'keys are down. This parameter can be any combination of the following  
'values: Value Description 
'MK_CONTROL Set if the ctrl key is down. 
'MK_LBUTTON Set if the left mouse button is down. 
'MK_MBUTTON Set if the middle mouse button is down. 
'MK_RBUTTON Set if the right mouse button is down. 
'MK_SHIFT Set if the shift key is down. 
' 
' 
'zDelta 
'The value of the high-order word of wParam. Indicates the distance that  
'the wheel is rotated, expressed in multiples or divisions of WHEEL_DELTA,  
'which is 120. A positive value indicates that the wheel was rotated  
'forward, away from the user; a negative value indicates that the wheel  
'was rotated backward, toward the user. 
'xPos 
'Value of the low-order word of lParam. Specifies the x-coordinate of the  
'pointer, relative to the upper-left corner of the screen. 
'yPos 
'Value of the high-order word of lParam. Specifies the y-coordinate of the  
'pointer, relative to the upper-left corner of the screen. 
On Error Resume Next 
Dim fwKeys As Long 
Dim zDelta As Long 
Dim xPos As Long 
Dim yPos As Long 
Dim Shift16 As Long 
Shift16 = 65536 
 
     
    If wParam < 0 Then 
        zDelta = ((CLng(wParam) And &HFFFF0000) \ Shift16) And &HFFFF&   
        '注: 第二个&一定要加 
        zDelta = zDelta - Shift16 
        Else 
        zDelta = ((CLng(wParam) And &HFFFF0000) \ Shift16) And &HFFFF& 
    End If 
    'zDelta>0: rotate forward   (toward the user) 
    'zDelta<0: rotata backward 
     
    fwKeys = (CLng(wParam) And &HFFFF&) 
    
'======================================================= 
'xPos和yPos是从屏幕的左上角开始计算,单位是象素 
     
    yPos = ((CLng(lParam) And &HFFFF0000) \ Shift16) And &HFFFF& 
     
    xPos = (CLng(lParam) And &HFFFF&) 
             
    Form1.VScroll1.Value = Form1.VScroll1.Value - Form1.VScroll1.SmallChange _ 
                          * zDelta \ 120 
 
End Sub 
 
-- 
你站在墙上看风景, 看风景人在楼上看你 
明月装饰了你的窗角, 你装饰了别人的梦. 
 
※ 来源:·BBS 水木清华站 smth.org·[FROM: 202.112.11.199]