怎樣將鼠標移到按鈕command上(程序動態移動)沒分了,謝謝

解决方案 »

  1.   


    Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
      

  2.   

    如何自动移动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 TypeDeclare 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) \ 2Call 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 LongPrivate 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 TypePrivate 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, 0mouse_event MOUSEEVENTF_ABSOLUTE Or _
    MOUSEEVENTF_LEFTUP, curx, cury, 0, 0End SubPrivate Sub Command2_Click()
    MsgBox "看你往哪儿逃!哈!!"
    End Sub