添加一个类模块,命名为:clsClick
以下为类代码:
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 Const MOUSEEVENTF_ABSOLUTE = &H8000 '指定鼠标使用绝对坐标系,此时,屏幕在水平和垂直方向上均匀分割成65535×65535个单元
Private Const MOUSEEVENTF_MOVE = &H1 '移动鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '模拟鼠标左键按下
Private Const MOUSEEVENTF_LEFTUP = &H4 '模拟鼠标左键抬起
'作用:移动鼠标
'参数:x,x轴点击位置,像素
'参数:y,y轴点击位置,像素
Public Sub screenMove(ByVal x As Long, ByVal y As Long)
mw = x / (Screen.Width / 15) * 65535
mh = y / (Screen.Height / 15) * 65535
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0, 0
' mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
'作用:移动鼠标
'参数:x,x轴点击位置,像素
'参数:y,y轴点击位置,像素
'参数:f,移动窗体名字
Public Sub formClick(ByVal x As Long, ByVal y As Long, f As Form)
f.SetFocus '//获得焦点
screenMove f.Left / 15 + x, f.Top / 15 + y
End Sub
'作用:屏幕点击
'参数:x,x轴点击位置,像素
'参数:y,y轴点击位置,像素
Public Sub screenClick(ByVal x As Long, ByVal y As Long)
mw = x / (Screen.Width / 15) * 65535
mh = y / (Screen.Height / 15) * 65535
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, mw, mh, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
'作用:vb窗体点击
'参数:x,x轴点击位置,像素
'参数:y,y轴点击位置,像素
'参数:f,单击窗体名字
Public Sub formMove(ByVal x As Long, ByVal y As Long, f As Form)
f.SetFocus '//获得焦点
screenClick f.Left / 15 + x, f.Top / 15 + y
End Sub
'//多次单击
Public Sub clickTimes(clickMsg, f As Form, Optional isScreenClick As Boolean = False)
Dim t, x, y, arr, a
If InStr(clickMsg, "|") = 0 Then clickMsg = clickMsg & "|" '//添加分隔符,因为首个单击可能不带
arr = Split(clickMsg, "|")
For a = 0 To UBound(arr)
If InStr(arr(a), "x:") > 0 And InStr(arr(a), "y:") > 0 Then
t = zq(arr(a), "t:", ";")
x = zq(arr(a), "x:", ";")
y = zq(arr(a), "y:", ";")
'//窗体点击
If isScreenClick = False Then
cls_delay Val(t) '//延时
formClick Val(x), Val(y), f '//单击事件
'//屏幕点击
Else
cls_delay Val(t) '//延时
screenClick Val(x), Val(y) '//单击事件
End If
End If
Next a
End Sub
Private Sub cls_delay(HowLong As Date)
'////hex 延时执行
Dim TempTime
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents '让 windows 去处理其他事
Wend
End Sub
Private Function zq(allStr, sta, fin) As String
'////hex '截取函数
Dim arr
Dim I, c
arr = Split(allStr, sta)
For I = 1 To UBound(arr)
If InStr(arr(I), fin) Then c = Split(arr(I), fin)(0)
Next I
zq = c
End Function
然后这调用:
Private Sub Command1_Click()
Dim d As clsClick
Set d = New clsClick
'多次单击事件:
d.clickTimes "t:0;x:110;y:82;|t:0;x:110;y:82;", Me '//在本窗体延时0秒单击了两次,坐标看x,y
Set d = Nothing
End Sub