鼠标滚轮消息的捕捉

简介: 鼠标滚轮消息的捕捉
'*************************************************************************
'**模 块 名: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
相关文章
|
10月前
键盘绑定按下事件
键盘绑定按下事件
33 0
|
7月前
鼠标悬浮显示文字的简单方法
鼠标悬浮显示文字的简单方法
|
10月前
|
开发框架 iOS开发
手机软键盘弹起导致页面变形的一种解决方案
手机软键盘弹起导致页面变形的一种解决方案
325 0
|
编解码
【PyAutoGUI操作指南】02 鼠标控制功能+获取当前坐标+鼠标事件+鼠标滚动查询
左上角的像素位于坐标0,0。如果屏幕分辨率为1920 x 1080,则右下角的像素将为1919,1079(因为坐标从0开始,而不是1)。
376 0
|
Java
swing中一些常见的鼠标事件(鼠标形状的改变、鼠标接近、按下(图标的切换)、鼠标接近、离开(字体颜色的改变)、鼠标拖拽等)还有系统托盘+对话框
swing中一些常见的鼠标事件(鼠标形状的改变、鼠标接近、按下(图标的切换)、鼠标接近、离开(字体颜色的改变)、鼠标拖拽等)还有系统托盘+对话框
429 0
swing中一些常见的鼠标事件(鼠标形状的改变、鼠标接近、按下(图标的切换)、鼠标接近、离开(字体颜色的改变)、鼠标拖拽等)还有系统托盘+对话框
重新认识键盘与鼠标——键盘事件与鼠标事件
重新认识键盘与鼠标——键盘事件与鼠标事件
255 0
重新认识键盘与鼠标——键盘事件与鼠标事件
|
Windows
Windows程序设计——窗口键盘消息滚动事件
Windows程序设计——窗口键盘消息滚动事件
245 0
|
移动开发 数据可视化 前端开发
解决安卓收起键盘无法触发失焦事件的问题
解决安卓收起键盘无法触发失焦事件的问题
1006 0
鼠标滑过抖动图标
在线演示 本地下载
1016 0

热门文章

最新文章