庞大资源库的计算机教程网站!
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]
首页 操作系统 程序设计 图形图像 媒体动画 机械电子 WEB开发 数 据 库 办公系列 路由技术 网络原理 网络应用
认证考试 安全技术
首页>程序设计>VB专区>编程技巧>正文
资料搜索
Google搜索
Google
返回上级列表

推荐文章

快速保存网页中所有图片的方法
Windows中让光驱巧妙“隐身”技
防范非法用户入侵Win 2000/XP系
两款比较典型的ASP木马防范方法
有关表格边框的css语法整理
Windows XP中可以被禁用的服务
SQL Server导出导入数据方法
Javascript所有对象的属性的获
网页(HTML)中的特殊字符
与篮球共舞,尽显模式本色
QQ病毒的手工清除方法
Photoshop为极品美女打造性感睫
天衣无缝:IIS与PHP水火也相容
SQL Server存储过程编写和优化

如何自动移动Mouse

 作者:本站收集   日期:2005-8-4 11:32:22
字号选择〖 〗/ 双击滚屏 单击停止   
事实上是使用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按键
Private 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的一般宣告区
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

上一篇:Visual Basic6.0实用编程技巧3例    下一篇:VB编程实用精典小技巧3例  
[发送给好友]  [关闭窗口]  [返回顶部]   转载请注明来源:www.it00.com   
特别声明: 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载,但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站,我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员,我们尽快予以更正。
责任编辑: 原点 投稿作者: 本站收集
信息来源: 网络 录入时间: 2005-8-4 11:32:22
关于我们 - 广告服务 - 版权申明 - 网站地图 - 联系方式 - 总编信箱 - 会员投稿