滑鼠滾輪消息的捕捉

'*************************************************************************
'**模 塊 名：basMouse
'**創 建 人：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**描    述：滑鼠鈎子
'**版    本：版本1.0
'*************************************************************************
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) - 視窗句柄
'**輸    出：無
'**功能描述：安裝滑鼠鈎子
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
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) - 視窗句柄
'**輸    出：無
'**功能描述：解除安裝滑鼠鈎子
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
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) -
'**輸    出：(Long) -
'**功能描述：視窗函數
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
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
             Else                 '朝顯示器方向
                bWay = False
             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位
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
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位
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2002年12月31日
'**修 改 人：
'**日    期：
'**版    本：版本1.0
'*************************************************************************
Public Function LOWORD(LongIn As Long) As Integer
   ' 取出32位值的低16位
     LOWORD = LongIn And &HFFFF&
End Function