您现在的位置: 中国男护士网 >> 考试频道 >> 计算机等级 >> 二级辅导 >> VB >> 真题 >> 正文    
  如何自动移动Mouse 【注册男护士专用博客】          

如何自动移动Mouse

www.nanhushi.com     佚名   不详 

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

 

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

  • 下一篇文章:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
     

    联 系 信 息
    QQ:88236621
    电话:15853773350
    E-Mail:malenurse@163.com
    免费发布招聘信息
    做中国最专业男护士门户网站
    最 新 热 门
    最 新 推 荐
    相 关 文 章
    如何自动移动Mouse
    专 题 栏 目

      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)                            【进男护士社区逛逛】
    姓 名:
    * 游客填写  ·注册用户 ·忘记密码
    主 页:

    评 分:
    1分 2分 3分 4分 5分
    评论内容:
  • 请遵守《互联网电子公告服务管理规定》及中华人民共和国其他各项有关法律法规。
  • 严禁发表危害国家安全、损害国家利益、破坏民族团结、破坏国家宗教政策、破坏社会稳定、侮辱、诽谤、教唆、淫秽等内容的评论 。
  • 用户需对自己在使用本站服务过程中的行为承担法律责任(直接或间接导致的)。
  • 本站管理员有权保留或删除评论内容。
  • 评论内容只代表网友个人观点,与本网站立场无关。