Mouse Movements

Here is a neat little module letting you simulate the user moving the mouse, and clicking on objects. Particularly useful for tutorial-style help. To move the mouse, call SetCursorPos(x,y), where x and y are the xy co-ordinates on the screen (in pixels). Then call the LeftDown, LeftClick etc procedures to simulate the mouse clicking.

** Please note that this code does not work in Windows 2000. You need to use the SendInput API instead ***

Many thanks to Dominique for sending me this. (Originally published in our discussion list).

Option Explicit

Public 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)

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1

Public Type POINTAPI
    X As Long
    Y As Long
    End Type

Public Function GetCurrentX() As Long
Dim Position As POINTAPI
    GetCursorPos Position
    GetCurrentX = Position.X
End Function

Public Function GetCurrentY() As Long
Dim Position As POINTAPI
    GetCursorPos Position
    GetCurrentY = Position.Y
End Function

Public Sub LeftClick()
    LeftDown
    LeftUp
End Sub

Public Sub LeftDown()
    Mouse_Event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Sub

Public Sub LeftUp()
    Mouse_Event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Sub MiddleClick()
    MiddleDown
    MiddleUp
End Sub

Public Sub MiddleDown()
    Mouse_Event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End Sub

Public Sub MiddleUp()
    Mouse_Event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End Sub

Public Sub MoveMouse(xMove As Long, yMove As Long)
    Mouse_Event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub

Public Sub RightClick()
    RightDown
    RightUp
End Sub

Public Sub RightDown()
    Mouse_Event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End Sub

Public Sub RightUp()
    Mouse_Event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub