| '----------------------------------------------------------------------
'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
'----------------------------------------------------------------------
|