Mouse


Description:
This is a simple wrapper class for mouse_event and Set/GetCursorPos. This class allows you to easily simulate mouse input without needing to use the API's directly.
 
Code:
'----------------------------------------------------------------------
'Begin: clsMouse

Option Explicit

'Windows API:
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40

Private Type POINTAPI
    x As Long
    y As Long
End Type

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 SetCursorPos Lib "user32" (ByVal x As Long, _
        ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As _
        POINTAPI) As Long

'Current screen coordinates
Public Property Let CurrentX(NewX As Long)

    Dim pt As POINTAPI
    GetCursorPos pt
    SetCursorPos NewX, pt.y

End Property

Public Property Get CurrentX() As Long

    Dim pt As POINTAPI
    GetCursorPos pt
    
    CurrentX = pt.x

End Property

Public Property Let CurrentY(NewY As Long)

    Dim pt As POINTAPI
    GetCursorPos pt
    SetCursorPos pt.x, NewY

End Property

Public Property Get CurrentY() As Long

    Dim pt As POINTAPI
    GetCursorPos pt
    
    CurrentY = pt.y

End Property

'Move the mouse cursor to a point
Public Sub MoveTo(ByVal x As Long, ByVal y As Long)

    SetCursorPos x, y

End Sub

'Move the mouse cursor, relative to the current position
Public Sub MoveRelative(ByVal x As Long, ByVal y As Long)

    Dim pt As POINTAPI
    GetCursorPos pt
    
    SetCursorPos pt.x + x, pt.y + y

End Sub

'Double click the mouse
Public Sub DblClick(Optional nButton As Long = vbLeftButton)

    Click nButton
    Click nButton
    
End Sub

'Single click
Public Sub Click(Optional nButton As Long = vbLeftButton)

    MouseDown nButton
    MouseUp nButton

End Sub

'Press and hold the mouse button
Public Sub MouseDown(Optional nButton As Long = vbLeftButton)

    Select Case nButton
        Case vbLeftButton
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        Case vbRightButton
            mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
        Case vbMiddleButton
            mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
    End Select

End Sub

'Release the mouse button
Public Sub MouseUp(Optional nButton As Long = vbLeftButton)

    Select Case nButton
        Case vbLeftButton
            mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
        Case vbRightButton
            mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
        Case vbMiddleButton
            mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
    End Select

End Sub

'End: clsMouse
'----------------------------------------------------------------------
 
Sample Usage:
 
    Dim mouse As clsMouse
    Set mouse = New clsMouse
    
    With mouse
        .MoveTo 0, 0
        .Click vbRightButton
    End With