/ Snippet Library - View Code

Visual Basic / Mouse Routines / Mouse Class Module

Snippet details

ID: 406

Viewed: 1280

Added: 2002-08-19

Version:

Snippets in this catagory
Show Printable Version

Mouse Class Module

General Details

Snippet uploaded by: snippet

Email : webmaster@snippetlibrary.com

Snippet By: Unknown

Snippet By:	Unknown
Declarations
Highlight AllOption 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
Code
Highlight All' 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 '

No Reviews to show