VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CMouse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Class: CMouse.cls                                                     '
' Usage: Control the mouse pointer, move, drag, and click on the screen '
' Copyright: 2004 Joacim Andersson, Brixoft Software                    '
' Web: http://www.brixoft.net                                           '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

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 GetCursorPos _
 Lib "user32" ( _
 lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up

Public Property Get X() As Long
    Dim tP As POINTAPI
    GetCursorPos tP
    X = tP.X
End Property

Public Property Get Y() As Long
    Dim tP As POINTAPI
    GetCursorPos tP
    Y = tP.Y
End Property

Public Property Let X(ByVal X As Long)
    MoveTo X, Y ' y from property get
End Property

Public Property Let Y(ByVal Y As Long)
    MoveTo X, Y ' x from property get
End Property

Public Sub MoveTo(ByVal X As Long, ByVal Y As Long)
'I could probably have use SetCursorPos but that would have
'required another API declaration :)
    Dim xl As Double
    Dim yl As Double
    Dim xMax As Long
    Dim yMax As Long
   
    'mouse_event ABSOLUTE coords run from 0 to 65535
    'so recalc from pixels
    xMax = Screen.Width \ Screen.TwipsPerPixelX
    yMax = Screen.Height \ Screen.TwipsPerPixelY
    xl = X * 65535 / xMax
    yl = Y * 65535 / yMax
    'Move the mouse
    mouse_event MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE, xl, yl, 0, 0
End Sub

Public Sub Click(Optional ByVal eButton As MouseButtonConstants = vbLeftButton)
    Dim nFlagDown As Long
    Dim nFlagUp As Long
    
    Select Case eButton
        Case vbRightButton
            nFlagDown = MOUSEEVENTF_RIGHTDOWN
            nFlagUp = MOUSEEVENTF_RIGHTUP
        Case vbMiddleButton
            nFlagDown = MOUSEEVENTF_MIDDLEDOWN
            nFlagUp = MOUSEEVENTF_MIDDLEUP
        Case Else
            nFlagDown = MOUSEEVENTF_LEFTDOWN
            nFlagUp = MOUSEEVENTF_LEFTUP
    End Select
    'a click = down then up
    mouse_event nFlagDown Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
    mouse_event nFlagUp Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
End Sub

Public Sub DblClick(Optional ByVal eButton As MouseButtonConstants = vbLeftButton)
    Dim nFlagDown As Long
    Dim nFlagUp As Long
    
    Select Case eButton
        Case vbRightButton
            nFlagDown = MOUSEEVENTF_RIGHTDOWN
            nFlagUp = MOUSEEVENTF_RIGHTUP
        Case vbMiddleButton
            nFlagDown = MOUSEEVENTF_MIDDLEDOWN
            nFlagUp = MOUSEEVENTF_MIDDLEUP
        Case Else
            nFlagDown = MOUSEEVENTF_LEFTDOWN
            nFlagUp = MOUSEEVENTF_LEFTUP
    End Select
    'a click = down then up
    'and a double click is two clicks :)
    mouse_event nFlagDown Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
    mouse_event nFlagUp Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
    mouse_event nFlagDown Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
    mouse_event nFlagUp Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
End Sub

Public Sub StartDrag(Optional ByVal eButton As MouseButtonConstants = vbLeftButton)
    Dim nFlagDown As Long
    
    Select Case eButton
        Case vbRightButton
            nFlagDown = MOUSEEVENTF_RIGHTDOWN
        Case vbMiddleButton
            nFlagDown = MOUSEEVENTF_MIDDLEDOWN
        Case Else
            nFlagDown = MOUSEEVENTF_LEFTDOWN
    End Select
    mouse_event nFlagDown Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
End Sub

Public Sub EndDrag(Optional ByVal eButton As MouseButtonConstants = vbLeftButton)
    Dim nFlagUp As Long
    Select Case eButton
        Case vbRightButton
            nFlagUp = MOUSEEVENTF_RIGHTUP
        Case vbMiddleButton
            nFlagUp = MOUSEEVENTF_MIDDLEUP
        Case Else
            nFlagUp = MOUSEEVENTF_LEFTUP
    End Select
    mouse_event nFlagUp Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
End Sub