📄 m67.htm
字号:
<html>
<head>
<title>VB教程</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<p align="center"><script src="../../1.js"></script></a>
<body bgcolor="#ffffff" leftmargin="5" topmargin="1" marginheight="5" marginwidth="5">
<div align=center>
<table border=0 cellpadding=0 cellspacing=0 width=680 align="center">
<tbody>
<tr>
<td bgcolor=#000000 height=9>
<div align=center class=H1> <font color="#FFFFFF">如何自动移动Mouse</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p align="left"> <br>
<font color="#000000">事实上是使用SetCursorPos()便可以了，而它的参数是对应於萤的座标，而不是对应某一个Window的Logic座标。这个例子中的MoveCursor()所传入的POINTAPI也是相对於萤的座标，指的是从点FromP移动到ToP最後面我也付了Showje的文章，使用的方式全部不同，不管是他的或我的，都有一个地方要解决才能做为Mouse自动导引的程式，那就是Mouse在自动Move时，如何让使用者不能移动Mouse，而这个问题就要使用JournalPlayBack
Hook，底下的程式中，使用EnableHook, FreeHook，这两个函数是Copy自如何使键盘、Mouse失效 。</font></span> <br>
</font></p>
<table border=0 width="719">
<tbody>
<tr>
<td> '以下程式在.bas<br>
Type RECT<br>
Left As Long<br>
ToP As Long<br>
Right As Long<br>
Bottom As Long<br>
End Type<br>
Type POINTAPI<br>
X As Long<br>
Y As Long<br>
End Type<br>
<br>
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal
Y As Long) As Long<br>
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long<br>
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)<br>
<br>
Public Sub MoveCursor(FromP As POINTAPI, ToP As POINTAPI)<br>
Dim stepx As Long, stepy As Long, k As Long<br>
Dim i As Long, j As Long, sDelay As Long<br>
stepx = 1<br>
stepy = 1<br>
i = (ToP.X - FromP.X)<br>
If i < 0 Then stepx = -1<br>
i = (ToP.Y - FromP.Y)<br>
If i < 0 Then stepy = -1<br>
'Call EnableHook '如果有Include htmapi53.htm的.bas时，会Disable Mouse<br>
For i = FromP.X To ToP.X Step stepx<br>
Call SetCursorPos(i, FromP.Y)<br>
Sleep (1) '让Mouse 的移动慢一点，这样效果较好<br>
Next i<br>
For i = FromP.Y To ToP.Y Step stepy<br>
Call SetCursorPos(ToP.X, i)<br>
Sleep (1)<br>
Next i<br>
'Call FreeHook 'Enable Mouse<br>
End Sub<br>
'以下程式在Form中，需3个Command按键<br>
Private Sub Command3_Click()<br>
Dim rect5 As RECT<br>
Dim p1 As POINTAPI, p2 As POINTAPI<br>
Call GetWindowRect(Command1.hwnd, rect5) '取得Command1相对於Screen的座标<br>
p1.X = (rect5.Left + rect5.Right) \ 2<br>
p1.Y = (rect5.ToP + rect5.Bottom) \ 2<br>
Call GetWindowRect(Command2.hwnd, rect5)<br>
p2.X = (rect5.Left + rect5.Right) \ 2<br>
p2.Y = (rect5.ToP + rect5.Bottom) \ 2<br>
<br>
Call MoveCursor(p1, p2) 'Mouse由Command1 ->Command2<br>
End Sub</font><br>
</td>
</tr>
</tbody>
</table>
<br>
<table border=0 width="704">
<tbody>
<tr>
<td><font color="#000000">另外从Showje的站有Copy以下的程式码，也是做相同的果，只是使用的API全部不同<br>
<br>
'以下程式在Form中，需2个Command按键<br>
'以下置於form的一般宣告区<br>
Private Declare Sub mouse_event Lib "user32" _<br>
( _<br>
ByVal dwFlags As Long, _<br>
ByVal dx As Long, _<br>
ByVal dy As Long, _<br>
ByVal cButtons As Long, _<br>
ByVal dwExtraInfo As Long _<br>
)<br>
<br>
Private Declare Function ClientToScreen Lib "user32" _<br>
( _<br>
ByVal hwnd As Long, _<br>
lpPoint As POINTAPI _<br>
) As Long<br>
<br>
Private Declare Function GetSystemMetrics Lib "user32" _<br>
( _<br>
ByVal nIndex As Long _<br>
) As Long<br>
Private Declare Function GetCursorPos Lib "user32" _<br>
( _<br>
lpPoint As POINTAPI _<br>
) As Long<br>
<br>
<br>
Private Type POINTAPI<br>
x As Long<br>
y As Long<br>
End Type<br>
<br>
Private Type OSVERSIONINFO<br>
dwOSVersionInfoSize As Long<br>
dwMajorVersion As Long<br>
dwMinorVersion As Long<br>
dwBuildNumber As Long<br>
dwPlatformId As Long<br>
szCSDVersion As String * 128<br>
End Type<br>
<br>
<br>
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move<br>
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down<br>
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up<br>
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move<br>
<br>
<br>
Private Sub Command1_Click()<br>
<br>
Dim pt As POINTAPI<br>
Dim dl&<br>
Dim destx&, desty&, curx&, cury&<br>
Dim distx&, disty&<br>
Dim screenx&, screeny&<br>
Dim finished%<br>
Dim ptsperx&, ptspery&<br>
<br>
pt.x = 10<br>
pt.y = 10<br>
dl& = ClientToScreen(Command2.hwnd, pt)<br>
<br>
screenx& = GetSystemMetrics(0) '0表x轴<br>
<br>
screeny& = GetSystemMetrics(1) '1表y轴<br>
<br>
destx& = pt.x * &HFFFF& / screenx&<br>
desty& = pt.y * &HFFFF& / screeny&<br>
<br>
<br>
ptsperx& = &HFFFF& / screenx&<br>
ptspery& = &HFFFF& / screeny&<br>
<br>
' Now move it<br>
Do<br>
dl& = GetCursorPos(pt)<br>
curx& = pt.x * &HFFFF& / screenx&<br>
cury& = pt.y * &HFFFF& / screeny&<br>
distx& = destx& - curx&<br>
disty& = desty& - cury&<br>
If (Abs(distx&) < 2 * ptsperx& And Abs(disty&) <
2 * ptspery) Then<br>
' Close enough, go the rest of the way<br>
curx& = destx&<br>
cury& = desty&<br>
finished% = True<br>
Else<br>
' Move closer<br>
curx& = curx& + Sgn(distx&) * ptsperx * 2<br>
cury& = cury& + Sgn(disty&) * ptspery * 2<br>
End If<br>
mouse_event MOUSEEVENTF_ABSOLUTE _<br>
Or MOUSEEVENTF_MOVE, curx, cury, 0, 0<br>
Loop While Not finished<br>
<br>
' 到家了，按上右键吧!注:是左键，Showje的笔误<br>
'以下是在(curx, cury)的座标下，模拟Mouse 左键的down and up<br>
mouse_event MOUSEEVENTF_ABSOLUTE Or _<br>
MOUSEEVENTF_LEFTDOWN, curx, cury, 0, 0<br>
<br>
mouse_event MOUSEEVENTF_ABSOLUTE Or _<br>
MOUSEEVENTF_LEFTUP, curx, cury, 0, 0<br>
<br>
End Sub<br>
<br>
Private Sub Command2_Click()<br>
MsgBox "看你往哪儿逃!哈!!"<br>
End Sub</font><br>
</td>
</tr>
</tbody>
</table>
<p align="right">
</table>
</div>
<p align="center"><a href="../../pian/vb.htm">回首页</a>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -