'*************************************************************************
'**模 块 名: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
分享到:
相关推荐
VB6内 响应鼠标滚轮事件,使用Hook钩子捕捉消息,具体处理过程需要自己编写
这是一个还有宏的 excel 工作簿,这是一个 xlsm 文档。该工作簿内实现了通过鼠标...该工作簿内包含一个 MouseWheel 模块,该模块捕捉了鼠标滚轮事件,并通过hook钩子使其达到操作 combox 或者 listbox 变更选项的目的。
winform键盘输入事件和鼠标滚轮事件的捕捉与重写
2.它提供了两个很有帮助事件mousewheel和unmousewheel来封装了滚轮的事件:使用方法如下: //绑定mousewheel事件 $('#my_elem').on('mousewheel', function(event) { console.log(event.deltaX, event.deltaY, ...
内容索引:VB源码,系统相关,滚轮,HOOK VB捕获鼠标滚轮动作的一个控件,附实例,可以知道鼠标滚轮是否在滚动,方向以及X/Y坐标等参数,也就是一个鼠标HOOK,跟踪鼠标的动作,截图如上。
滚动事件触发时Firefox使用detail属性捕捉滚轮信息,其他的浏览器使用wheelDelta。不知道为何在该问题上其他厂商和微软的如此一致。Firefox可以使用addEventListener方法绑定DomMouseScroll事件。 elem.addE
3.鼠标滚轮向后(鼠标操作)或二指向外移动(触屏)可以跳过对进度条的误判断导致的捕捉中止。 4.捕捉前设置全屏看书模式比较好。 5.开始页数字最好的当当看书的控制条页码一致,这样方便些。 6.转换成PDF电子书,就...
5:滚动鼠标滚轮可放大或缩小橡皮擦;6:键盘上加减键和鼠标滚轮可改变圆角矩形的圆角半径;7:按Esc键清除画板,当前正在输入文字时会取消当前的输入;8:Ctrl C可以复制到剪贴板;9:数字快捷键(1—8)选择画刷类型...
6:键盘上加减键和鼠标滚轮可改变圆角矩形的圆角半径;。7:按Esc键清除画板,当前正在输入文字时会取消当前的输入;。8:Ctrl+C可以复制到剪贴板;。9:数字快捷键(1—8)选择画刷类型;。10:绘制工具有快捷键,和...
这个假期玩了不少galgame,不过有些很老的游戏没有自动运行模式,点击鼠标又太伤按键了,于是想把滚动鼠标滚轮映射为点击鼠标。 网上搜了一下,没发现什么现成的软件,而按键精灵又太重量级了,于是考虑干脆自己用...
VivioJS中的标尺和指南针构造运行动画动画包含在以下路径中:..... VivioJS动画可以在Windows,Linux和OS X上的Firefox,Chrome,Opera,Safari,IE和Edge中运行。... 暂停动画,然后按SHIFT键并旋转鼠标滚轮,可捕捉到下
1. 修正了文本捕捉功能里 "使用自动滚动捕捉文本" 的其它问题 - 无法使用鼠标滚轮自动滚动窗口 HyperSnap 6.21.03 1. 修正了文本捕捉功能里面的 "使用自动滚动捕捉文本" HyperSnap 6.21.02 2007.08.17 1. 修正了...
尽管最近对overflow: scroll (或触摸等效项)的支持有所增加,但通常仍不能以跨平台或向后兼容的方式实现,并且不支持捕捉等功能。 FTScroller由英国《金融时报》旗下的开发。 它受和启发,但已完全重写。 它在中...
MOUSE_POINTS网格中的输入节点。 Mouse_Points 允许使用 ginput Matlab ... 左键单击:添加一个点滚动:放大/缩小滚轮点击:平移双滚轮单击:将视图重置为默认视图右键单击:设置新的默认视图输入:返回 [n XY] 矩阵
5:滚动鼠标滚轮可放大或缩小橡皮擦;6:键盘上加减键和鼠标滚轮可改变圆角矩形的圆角半径;7:按Esc键清除画板,当前正在输入文字时会取消当前的输入;8:Ctrl+C可以复制到剪贴板;9:数字快捷键(1—8)选择画刷类型...
功能包括拖动,捏到缩放,鼠标滚轮缩放,减速拖动,跟随目标,动画,捕捉到点,捕捉到缩放,夹紧,在边缘弹跳以及在鼠标边缘移动。 查看现场示例,尝试所有这些功能。 所有功能都是可配置和可移动的,因此请根据您...
新增功能:双光标,鼠标滚轮功能。 : 新增功能:将光标捕捉到最近的数据点,为图表光标选择系列。 新增功能:主题,缓冲模式,游标标签格式和游标导航。 讨论了在MSChart缓冲模式下实现下采样算法的方法。
录制后的效果:高亮鼠标指针,点击动作和滚动滚轮会出现圆圈和箭头。 录制前重新设置屏幕分辨率 录制前隐藏桌面图标,录制后恢复。 录制声卡声音或麦克风。我测试了好多录制屏幕的软件,基本上都不支持我的...
4滚动中间滚轮,可以放大缩小所有图形,按下中间滚轮拖动鼠标可以移动所有图形,移动一部分图形要用移动命令。 5用修剪命令时,先单击修剪命令再回车,点击不要的图线,再回车。修剪不了的图线是因为没有剪切边,要...