VB编程如何获取鼠标双击事件

发布网友 发布时间：2022-04-29 15:33

我来回答

共4个回答

热心网友 时间：2023-10-15 21:15

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

热心网友 时间：2023-10-15 21:15

在控件上用DblClick事件啊，比如你鼠标移动的范围是在PictureBox控件上，那么就在PictureBox控件的DblClick中编程

热心网友 时间：2023-10-15 21:16

以下在模块中

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

热心网友 时间：2023-10-15 21:16

双击任何位置可以用键盘钩子 SetWindowsHookEx WH_KEYBOARD KeyboardProc

热心网友 时间：2023-10-15 21:15

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

热心网友 时间：2023-10-15 21:15

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

热心网友 时间：2023-10-15 21:15

在控件上用DblClick事件啊，比如你鼠标移动的范围是在PictureBox控件上，那么就在PictureBox控件的DblClick中编程

热心网友 时间：2023-10-15 21:16

以下在模块中

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

热心网友 时间：2023-10-15 21:15

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

热心网友 时间：2023-10-15 21:15

在控件上用DblClick事件啊，比如你鼠标移动的范围是在PictureBox控件上，那么就在PictureBox控件的DblClick中编程

热心网友 时间：2023-10-15 21:15

在控件上用DblClick事件啊，比如你鼠标移动的范围是在PictureBox控件上，那么就在PictureBox控件的DblClick中编程

热心网友 时间：2023-10-15 21:16

以下在模块中

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

热心网友 时间：2023-10-15 21:16

双击任何位置可以用键盘钩子 SetWindowsHookEx WH_KEYBOARD KeyboardProc

热心网友 时间：2023-10-15 21:16

以下在模块中

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

热心网友 时间：2023-10-15 21:16

双击任何位置可以用键盘钩子 SetWindowsHookEx WH_KEYBOARD KeyboardProc

热心网友 时间：2023-10-15 21:16

双击任何位置可以用键盘钩子 SetWindowsHookEx WH_KEYBOARD KeyboardProc