📄 ba25.htm
字号:
<HTML>
<HEAD>
<TITLE>如何自动移动Mouse</TITLE>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
</head>
<p align="center"><script src="../../1.js"></script></a>
<BODY topMargin=4 vLink=#0000ff>
<TABLE border=0 cellPadding=0 cellSpacing=0 width="100%">
<TBODY>
<TR>
<TD height="52">
<DIV align=center>
<CENTER>
<table border=0 cellpadding=0 cellspacing=0 width=679 align="center">
<tbody>
<tr>
<td width=200 height="59">
</TD></TR><!--msnavigation--></TBODY></TABLE>
<table border=0 cellpadding=0 cellspacing=0 width="100%">
<tbody>
<tr><!--msnavigation--><td valign=top height="123">
<div align=center>
<table border=1 bordercolor=#b9d9ff cellpadding=0 cellspacing=0
class=table width=755>
<center>
<tr>
<td width="100%" height="5">
<div align="center"> <strong><b>如何自动移动Mouse</b>
</strong></span></div>
</td>
</tr>
<tr>
<td
width="100%" class="unnamed1" height="124">
<div align="left"> <br>
<font size="-1" face="宋体">事实上是使用SetCursorPos()便可以了，而它的参数是对应於萤的座标，而不是对应某一个Window的Logic座标。这个例子中的MoveCursor()所传入的POINTAPI也是相对於萤屏的座标，指的是从点FromP移动到ToP。最後面我也付了Showje的文章，使用的方式全部不同，不管是他的或我的，都有一个地方要解决才能做为Mouse自动导引的程式，那就是Mouse在自动Move时，如何让使用者不能移动Mouse，而这个问题就要使用JournalPlayBack
Hook，底下的程式中，使用 EnableHook, FreeHook，这两个函数是Copy自如何使键盘、Mouse失效
。<br>
<br>
'以下程式在.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 <br>
<br>
另外从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 <br>
<br>
转载自popcool开发专区</font></div>
</td>
</tr>
</center>
<tr>
<td width="100%" class="unnamed1">
<p align=right><a href="ba24.htm">（上一页）</a>---<a href="ba26.htm">（下一页）</a></p>
</td>
</tr>
<tr>
<td width="100%" class="unnamed1">
</td>
</tr>
<!--msnavigation--></tbody>
</table>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -