VB编程如何获取鼠标双击事件
就是在鼠标双击的时候获取其事件我指的是鼠标双击在任何地方比如浏览器如何获取其事件并执行操作...
就是在鼠标双击的时候获取其事件 我指的是鼠标双击在任何地方 比如浏览器 如何获取其事件 并执行操作
展开
4个回答
展开全部
Option Explicit
Private Declare Function GetDoubleClickTime Lib "user32" () As Long '获得双击时间间隔
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '获得鼠标状态
Dim PreviousTime As Double
Dim DBClickTime As Double
Private Sub Form_Load()
DBClickTime = GetDoubleClickTime / 1000
End Sub
Private Sub Timer1_Timer() 'Timer的interval属性值设为小一点例如100
Dim IsDBClick As Boolean
If GetAsyncKeyState(1) <> 0 Then '1为左键,2为右键,4为中键
If Timer - PreviousTime < DBClickTime Then IsDBClick = True
PreviousTime = Timer
End If
If IsDBClick = True Then
'这里写当检测到鼠标双击时要执行的代码
End If
End Sub
Private Declare Function GetDoubleClickTime Lib "user32" () As Long '获得双击时间间隔
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '获得鼠标状态
Dim PreviousTime As Double
Dim DBClickTime As Double
Private Sub Form_Load()
DBClickTime = GetDoubleClickTime / 1000
End Sub
Private Sub Timer1_Timer() 'Timer的interval属性值设为小一点例如100
Dim IsDBClick As Boolean
If GetAsyncKeyState(1) <> 0 Then '1为左键,2为右键,4为中键
If Timer - PreviousTime < DBClickTime Then IsDBClick = True
PreviousTime = Timer
End If
If IsDBClick = True Then
'这里写当检测到鼠标双击时要执行的代码
End If
End Sub
展开全部
在控件上用DblClick事件啊,比如你鼠标移动的范围是在PictureBox控件上,那么就在PictureBox控件的DblClick中编程
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
以下在模块中
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Const WH_MOUSE_LL = 14
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public MouseMsg As MOUSEMSGS
Public lHook As Long
'----------------------------------------
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTAPI, DBLCLK As Long
Static DBtime As Long
DBLCLK = GetDoubleClickTime
If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)
If wParam = 513 And MouseMsg.time - DBtime <= DBLCLK Then MsgBox "双击"
If wParam = 512 Then DBtime = 0
If wParam = 514 Then DBtime = MouseMsg.time
End If
If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function
以下在 form1 中
'安装钩子
Private Sub AddHook()
'鼠标钩子
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
'卸钩子
Private Sub DelHook()
UnhookWindowsHookEx lHook
End Sub
Private Sub Command1_Click()
DelHook '卸钩子
End Sub
Private Sub Form_Load()
AddHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
DelHook
End Sub
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Const WH_MOUSE_LL = 14
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public MouseMsg As MOUSEMSGS
Public lHook As Long
'----------------------------------------
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTAPI, DBLCLK As Long
Static DBtime As Long
DBLCLK = GetDoubleClickTime
If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)
If wParam = 513 And MouseMsg.time - DBtime <= DBLCLK Then MsgBox "双击"
If wParam = 512 Then DBtime = 0
If wParam = 514 Then DBtime = MouseMsg.time
End If
If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function
以下在 form1 中
'安装钩子
Private Sub AddHook()
'鼠标钩子
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
'卸钩子
Private Sub DelHook()
UnhookWindowsHookEx lHook
End Sub
Private Sub Command1_Click()
DelHook '卸钩子
End Sub
Private Sub Form_Load()
AddHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
DelHook
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
双击任何位置可以用键盘钩子 SetWindowsHookEx WH_KEYBOARD KeyboardProc
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询