如何自動(dòng)移動(dòng)Mouse

字號:

事實(shí)上是使用SetCursorPos()便可以了,而它的參數(shù)是對應(yīng)於螢的座標(biāo),而不是對應(yīng)某一個(gè)Window的Logic座標(biāo)。這個(gè)例子中的MoveCursor()所傳入的POINTAPI也是相對於螢屏的座標(biāo),指的是從點(diǎn)FromP移動(dòng)到ToP。最後面我也付了Showje的文章,使用的方式全部不同,不管是他的或我的,都有一個(gè)地方要解決才能做為Mouse自動(dòng)導(dǎo)引的程式,那就是Mouse在自動(dòng)Move時(shí),如何讓使用者不能移動(dòng)Mouse,而這個(gè)問題就要使用JournalPlayBack Hook,底下的程式中,使用 EnableHook, FreeHook,這兩個(gè)函數(shù)是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時(shí),會(huì)Disable Mouse
    For i = FromP.X To ToP.X Step stepx
    Call SetCursorPos(i, FromP.Y)
    Sleep (1) '讓Mouse 的移動(dòng)慢一點(diǎn),這樣效果較好
    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個(gè)Command按鍵
    Private Sub Command3_Click()
    Dim rect5 As RECT
    Dim p1 As POINTAPI, p2 As POINTAPI
    Call GetWindowRect(Command1.hwnd, rect5) '取得Command1相對於Screen的座標(biāo)
    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個(gè)Command按鍵
    '以下置於form的一般宣告區(qū)
    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