Question

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

Answer 1

private
sub
command1_mousemove(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
command1.mousepointer
=
vbcross
end
sub
private
sub
command1_mouseup(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
if
button
=
vbrightbutton
then
msgbox
"现在鼠标光标位于命令按钮中"
end
if
end
sub
private
sub
form_load()
'picture1.mouseicon
=
loadpicture("c:\hand.cur")'光标文件的路径
end
sub
private
sub
form_mousemove(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
me.mousepointer
=
vbdefault
end
sub
private
sub
form_mouseup(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
if
button
=
vbrightbutton
then
msgbox
"现在鼠标光标位于窗体上"
end
if
end
sub
private
sub
picture1_mousemove(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
picture1.mousepointer
=
vbcustom
end
sub
private
sub
picture1_mouseup(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
if
button
=
vbrightbutton
then
msgbox
"现在鼠标光标位于图片框中"
end
if
end
sub
private
sub
text1_mousemove(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
text1.mousepointer
=
vbhourglass
end
sub
private
sub
text1_mouseup(button
as
integer,
shift
as
integer,
x
as
single,
y
as
single)
if
button
=
vbrightbutton
then
msgbox
"现在鼠标光标位于文本框中"
end
if
end
sub

Answer 2

以下在模块中
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

Answer 3

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

Answer 4

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