(VB!) 如何实现鼠标模拟?
我的系统为XP,分辨率为1024×768.这是我声明的两个函数OptionExplicit'用于模拟鼠标运动的函数:PrivateDeclareSubmouse_even...
我的系统为XP,分辨率为1024×768.
这是我声明的两个函数
Option Explicit
'用于模拟鼠标运动的函数:
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'用于控制鼠标移动位置的函数:
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'mouse_event的常数参数
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_ABSOLUTE = &H8000
刚一开始我使用 SetCursorPos函数成功了一次,在想单击的坐标处成功进行了单机。
可是我想做的是一组动作,SetCursorPos函数好像只能执行一次这种操作,再下面的鼠标动作语句它就不执行了!
我想问下各位大大,我要实现一组操作,代码该怎么写,麻烦写出一些简单的范例,谢谢了! 展开
这是我声明的两个函数
Option Explicit
'用于模拟鼠标运动的函数:
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
'用于控制鼠标移动位置的函数:
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'mouse_event的常数参数
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_ABSOLUTE = &H8000
刚一开始我使用 SetCursorPos函数成功了一次,在想单击的坐标处成功进行了单机。
可是我想做的是一组动作,SetCursorPos函数好像只能执行一次这种操作,再下面的鼠标动作语句它就不执行了!
我想问下各位大大,我要实现一组操作,代码该怎么写,麻烦写出一些简单的范例,谢谢了! 展开
展开全部
'这是一个鼠标模拟点击开始菜单的例子,你可以参考程序中的连续点击的过程。
'在窗体上加入控件timer1(interval=1000),然后在窗体代码区复制下面代码,运行,即可看到效果。
'====窗体代码区====
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long
Private Enum MouseClick '定义鼠标常数
MOUSEEVENTF_LEFTDOWN = &H2
MOUSEEVENTF_LEFTUP = &H4
MOUSEEVENTF_RIGHTDOWN = &H8
MOUSEEVENTF_RIGHTUP = &H10
MOUSEEVENTF_MIDDLEDOWN = &H20
MOUSEEVENTF_MIDDLEUP = &H40
End Enum
Private Const INPUT_MOUSE = 0
Private Const INPUT_KEYBOARD = 1
Private Const INPUT_HARDWARE = 2
Private Type MOUSEINPUT
dx As Long
dy As Long
mouseData As Long
dwFlags As Long
dwtime As Long
dwExtraInfo As Long
End Type
Private Type INPUT_TYPE
dwType As Long
xi(0 To 23) As Byte
End Type
Dim tp_X As Single, tp_Y As Single
Dim ClkIndex As Integer
Dim OpCtWin As Integer
Private Sub VirtualClickMouse(ButtonPressed As MouseClick, Optional ButtonRelease As MouseClick)
Dim intX As Integer
Dim inputEvents(0 To 1) As INPUT_TYPE ' 锁定事件信息
Dim mouseEvent As MOUSEINPUT '临时锁定鼠标输入信息
mouseEvent.dx = 0 ' 不水平运动
mouseEvent.dy = 0 ' 不垂直运动
mouseEvent.mouseData = 0
mouseEvent.dwFlags = ButtonPressed ' 按键按下
mouseEvent.dwtime = 0 ' 缺省
mouseEvent.dwExtraInfo = 0 ' 非必须
' 复制结构到输入数组缓冲区
inputEvents(0).dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory inputEvents(0).xi(0), mouseEvent, Len(mouseEvent)
' 相上, 放开鼠标按钮。
mouseEvent.dx = 0
mouseEvent.dy = 0
mouseEvent.mouseData = 0
mouseEvent.dwFlags = ButtonRelease ' 按键抬起
mouseEvent.dwtime = 0
mouseEvent.dwExtraInfo = 0
inputEvents(1).dwType = INPUT_MOUSE
CopyMemory inputEvents(1).xi(0), mouseEvent, Len(mouseEvent)
intX = SendInput(2, inputEvents(0), Len(inputEvents(0))) '
End Sub
Sub MoveMouse(X As Single, Y As Single)
Dim pt As POINTAPI
pt.X = X
pt.Y = Y
ClientToScreen hwnd, pt
SetCursorPos pt.X, pt.Y
End Sub
Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
ClkIndex = 0
OpCtWin = 0
End Sub
Private Sub Timer2_Timer()
Select Case OpCtWin
Case Is = 0
tp_X = (-Me.Left / Screen.TwipsPerPixelX) + 40
tp_Y = (Me.Top + Me.Height) / Screen.TwipsPerPixelY - 20
Case Is = 1
tp_X = (-Me.Left / Screen.TwipsPerPixelX) + 40
tp_Y = (Me.Top + Me.Height) / Screen.TwipsPerPixelY - 50
End Select
MoveMouse tp_X, tp_Y
VirtualClickMouse MOUSEEVENTF_LEFTDOWN, MOUSEEVENTF_LEFTUP
OpCtWin = OpCtWin + 1
If OpCtWin > 1 Then
OpCtWin = 0
Timer2.Enabled = False
Unload Me
End If
End Sub
'在窗体上加入控件timer1(interval=1000),然后在窗体代码区复制下面代码,运行,即可看到效果。
'====窗体代码区====
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long
Private Enum MouseClick '定义鼠标常数
MOUSEEVENTF_LEFTDOWN = &H2
MOUSEEVENTF_LEFTUP = &H4
MOUSEEVENTF_RIGHTDOWN = &H8
MOUSEEVENTF_RIGHTUP = &H10
MOUSEEVENTF_MIDDLEDOWN = &H20
MOUSEEVENTF_MIDDLEUP = &H40
End Enum
Private Const INPUT_MOUSE = 0
Private Const INPUT_KEYBOARD = 1
Private Const INPUT_HARDWARE = 2
Private Type MOUSEINPUT
dx As Long
dy As Long
mouseData As Long
dwFlags As Long
dwtime As Long
dwExtraInfo As Long
End Type
Private Type INPUT_TYPE
dwType As Long
xi(0 To 23) As Byte
End Type
Dim tp_X As Single, tp_Y As Single
Dim ClkIndex As Integer
Dim OpCtWin As Integer
Private Sub VirtualClickMouse(ButtonPressed As MouseClick, Optional ButtonRelease As MouseClick)
Dim intX As Integer
Dim inputEvents(0 To 1) As INPUT_TYPE ' 锁定事件信息
Dim mouseEvent As MOUSEINPUT '临时锁定鼠标输入信息
mouseEvent.dx = 0 ' 不水平运动
mouseEvent.dy = 0 ' 不垂直运动
mouseEvent.mouseData = 0
mouseEvent.dwFlags = ButtonPressed ' 按键按下
mouseEvent.dwtime = 0 ' 缺省
mouseEvent.dwExtraInfo = 0 ' 非必须
' 复制结构到输入数组缓冲区
inputEvents(0).dwType = INPUT_MOUSE ' 鼠标输入
CopyMemory inputEvents(0).xi(0), mouseEvent, Len(mouseEvent)
' 相上, 放开鼠标按钮。
mouseEvent.dx = 0
mouseEvent.dy = 0
mouseEvent.mouseData = 0
mouseEvent.dwFlags = ButtonRelease ' 按键抬起
mouseEvent.dwtime = 0
mouseEvent.dwExtraInfo = 0
inputEvents(1).dwType = INPUT_MOUSE
CopyMemory inputEvents(1).xi(0), mouseEvent, Len(mouseEvent)
intX = SendInput(2, inputEvents(0), Len(inputEvents(0))) '
End Sub
Sub MoveMouse(X As Single, Y As Single)
Dim pt As POINTAPI
pt.X = X
pt.Y = Y
ClientToScreen hwnd, pt
SetCursorPos pt.X, pt.Y
End Sub
Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
ClkIndex = 0
OpCtWin = 0
End Sub
Private Sub Timer2_Timer()
Select Case OpCtWin
Case Is = 0
tp_X = (-Me.Left / Screen.TwipsPerPixelX) + 40
tp_Y = (Me.Top + Me.Height) / Screen.TwipsPerPixelY - 20
Case Is = 1
tp_X = (-Me.Left / Screen.TwipsPerPixelX) + 40
tp_Y = (Me.Top + Me.Height) / Screen.TwipsPerPixelY - 50
End Select
MoveMouse tp_X, tp_Y
VirtualClickMouse MOUSEEVENTF_LEFTDOWN, MOUSEEVENTF_LEFTUP
OpCtWin = OpCtWin + 1
If OpCtWin > 1 Then
OpCtWin = 0
Timer2.Enabled = False
Unload Me
End If
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |