douces 2007-12-4 09:23
如何使用程序自动移动Mouse
事实上是使用SetCursorPos()便可以了,而它的参数是对应於萤的座标,而不是对应某一个Window的Logic座标。这个例子中的MoveCursor()所传入的POINTAPI也是相对於萤屏的座标,指的是从点FromP移动到ToP。最後面我也付了Showje的文章,使用的方式全部不同,不管是他的或我的,都有一个地方要解决才能做为Mouse自动导引的程式,那就是Mouse在自动Move时,如何让使用者不能移动Mouse,而这个问题就要使用JournalPlayBack Hook,底下的程式中,使用 EnableHook, FreeHook,这两个函数是Copy自如何使键盘、Mouse失效 。
'以下程式在.bas
Type RECT
Left As Long
ToP As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
X As Long
Y As Long
End Type
Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub MoveCursor(FromP As POINTAPI, ToP As POINTAPI)
Dim stepx As Long, stepy As Long, k As Long
Dim i As Long, j As Long, sDelay As Long
stepx = 1
stepy = 1
i = (ToP.X - FromP.X)
If i < 0 Then stepx = -1
i = (ToP.Y - FromP.Y)
If i < 0 Then stepy = -1
'Call EnableHook '如果有Include htmapi53.htm的.bas时,会Disable Mouse
For i = FromP.X To ToP.X Step stepx
Call SetCursorPos(i, FromP.Y)
Sleep (1) '让Mouse 的移动慢一点,这样效果较好
Next i
For i = FromP.Y To ToP.Y Step stepy
Call SetCursorPos(ToP.X, i)
Sleep (1)
Next i
'Call FreeHook 'Enable Mouse
End Sub
'以下程式在Form中,需3个Command按键
** Sub Command3_Click()
Dim rect5 As RECT
Dim p1 As POINTAPI, p2 As POINTAPI
Call GetWindowRect(Command1.hwnd, rect5) '取得Command1相对於Screen的座标
p1.X = (rect5.Left rect5.Right) \ 2
p1.Y = (rect5.ToP rect5.Bottom) \ 2
Call GetWindowRect(Command2.hwnd, rect5)
p2.X = (rect5.Left rect5.Right) \ 2
p2.Y = (rect5.ToP rect5.Bottom) \ 2
Call MoveCursor(p1, p2) 'Mouse由Command1 ->Command2
End Sub
另外从Showje的站有Copy以下的程式码,也是做相同的果,只是使用的API全部不同
'以下程式在Form中,需2个Command按键
'以下置於form的一般宣告区
** 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 _
)
** Declare Function ClientToScreen Lib "user32" _
( _
ByVal hwnd As Long, _
lpPoint As POINTAPI _
) As Long
** Declare Function GetSystemMetrics Lib "user32" _
( _
ByVal nIndex As Long _
) As Long
** Declare Function GetCursorPos Lib "user32" _
( _
lpPoint As POINTAPI _
) As Long
** Type POINTAPI
x As Long
y As Long
End Type
** Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
** Const MOUSEEVENTF_MOVE =