另外从Showje的站有Copy以下的程式码,也是做相同的果,只是使用的API全部不同
'以下程式在Form中,需2个Command按键
'以下置於form的一般宣告区
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 ClientToScreen Lib "user32" _
( _
ByVal hwnd As Long, _
lpPoint As POINTAPI _
) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
( _
ByVal nIndex As Long _
) As Long
Private Declare Function GetCursorPos Lib "user32" _
( _
lpPoint As POINTAPI _
) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Sub Command1_Click()
Dim pt As POINTAPI
Dim dl&
Dim destx&, desty&, curx&, cury&
Dim distx&, disty&
Dim screenx&, screeny&
Dim finished%
Dim ptsperx&, ptspery&
pt.x = 10
pt.y = 10
dl& = ClientToScreen(Command2.hwnd, pt)
screenx& = GetSystemMetrics(0) '0表x轴
screeny& = GetSystemMetrics(1) '1表y轴
destx& = pt.x * &HFFFF& / screenx&
desty& = pt.y * &HFFFF& / screeny&
ptsperx& = &HFFFF& / screenx&
ptspery& = &HFFFF& / screeny&
' Now move it
Do
dl& = GetCursorPos(pt)
curx& = pt.x * &HFFFF& / screenx&
cury& = pt.y * &HFFFF& / screeny&
distx& = destx& - curx&
disty& = desty& - cury&
If (Abs(distx&) < 2 * ptsperx& And Abs(disty&) < 2 * ptspery) Then
' Close enough, go the rest of the way
curx& = destx&
cury& = desty&
finished% = True
Else
' Move closer
curx& = curx& + Sgn(distx&) * ptsperx * 2
cury& = cury& + Sgn(disty&) * ptspery * 2
End If
mouse_event MOUSEEVENTF_ABSOLUTE _
Or MOUSEEVENTF_MOVE, curx, cury, 0, 0
Loop While Not finished
' 到家了,按上右键吧!注:是左键,Showje的笔误
'以下是在(curx, cury)的座标下,模拟Mouse 左键的down and up
mouse_event MOUSEEVENTF_ABSOLUTE Or _
MOUSEEVENTF_LEFTDOWN, curx, cury, 0, 0
mouse_event MOUSEEVENTF_ABSOLUTE Or _
MOUSEEVENTF_LEFTUP, curx, cury, 0, 0
End Sub
Private Sub Command2_Click()
MsgBox "看你往哪儿逃!哈!!"
End Sub
|