| 网站首页 | JAVA文章 | AppServers | Web开发 | 应用开发 | 资源下载 | 论坛
    想学好编程,学好外语很重要  [enadd  2006年12月25日]        
设为首页 加入收藏 联系站长
您现在的位置: 编程笔记网 >> 应用开发 >> vb >> API >> 文章正文
如何自动移动Mouse            【字体:
如何自动移动Mouse
作者:-    文章来源:-    点击数:    更新时间:2006-6-8

事实上是使用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
 

文章录入:enadd    责任编辑:enadd 
  • 上一篇文章:

  • 下一篇文章:
  • 发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
    最新热点 最新推荐 相关文章
  • 用VB编写DirectX7.0游戏(下…

  • 用VB编写DirectX7.0游戏(上…

  • 使用OLE DB和ADO调用返回记录…

  • 使用VB调用Oracle程序包内的…

  • VB中用ADO对象动态创建数据库…

  • fffff

  • 如何用MSComm Control传Bina…

  • MultiLink的WinSock Server程…

  • 用VB制作浏览器

  • 用VB编写网络寻呼机

  •   网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)
    | 设为首页 | 加入收藏 | 联系站长 | 友情链接 | 版权申明 | 管理登录 |