MouseClsMod

Option Explicit

DefInt A-Z

Private Type POINTAPI_TYPE
x As Long
y As Long
End Type

Private Type RECT_TYPE
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const SM_MOUSEPRESENT = 19
Private Const SM_SWAPBUTTON = 23
Private Const SM_CMOUSEBUTTONS = 43
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As ong) As Long
Private Declare Function SwapMouseButton Lib "user32" _
(ByVal bSwap As Long) 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_TYPE) As Long
Private Declare Function ShowCursor Lib "user32" _
(ByVal bShow As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, ByVal yPoint As Long) As Long

' returns True (-1) if mouse installed

Public Function mThere() As Boolean
mThere = GetSystemMetrics(SM_MOUSEPRESENT) = 1
End Function

' returns X pos of mouse

Public Property Get CurrentX() As Long
Dim pt As POINTAPI_TYPE
GetCursorPos pt
CurrentX = pt.x
End Property

' sets X pos of mouse

Public Property Let CurrentX(x As Long)
Dim pt As POINTAPI_TYPE
GetCursorPos pt
pt.x = x
SetCursorPos pt.x, pt.y
End Property

' returns Y pos of mouse

Public Property Let CurrentY(y As Long)
Dim pt As POINTAPI_TYPE
GetCursorPos pt
pt.y = y
SetCursorPos pt.x, pt.y
End Property

' sets Y pos of mouse

Public Property Get CurrentY() As Long
Dim pt As POINTAPI_TYPE
GetCursorPos pt
CurrentY = pt.y
End Property

'

' swapping routines

'

' swaps mouse buttons

Public Sub mSwap()
SwapMouseButton True
End Sub

'un-swaps mouse buttons

Public Sub Unswap()
SwapMouseButton False
End Sub

' returns True (-1) is buttons swapped

Public Function mSwapped() As Boolean
mSwapped = GetSystemMetrics(SM_SWAPBUTTON) = 1
End Function

'

' button state functions

'


' returns True (-1) if Left button down

Public Function LeftButtonPress() As Boolean
GetAsyncKeyState vbKeyLButton
LeftButtonPress = _
Not (GetAsyncKeyState(vbKeyLButton) And &HFFFF) = 0
End Function

' returns True (-1) if Middle button down

Public Function MiddleButtonPress() As Boolean
GetAsyncKeyState vbKeyMButton
MiddleButtonPress = _
Not (GetAsyncKeyState(vbKeyMButton) And &HFFFF) = 0
End Function

' returns True (-1) if Right button down

Public Function RightButtonPress() As Boolean
GetAsyncKeyState vbKeyRButton
RightButtonPress = _
Not (GetAsyncKeyState(vbKeyRButton) And &HFFFF) = 0
End Function

' moves cursor

Public Sub Move(x As Long, y As Long)
SetCursorPos x, y
End Sub

' returns number of buttons

Public Function btnCount() As Long
btnCount = GetSystemMetrics(SM_CMOUSEBUTTONS)
End Function