Moving, Clicking and Tracking the MousePointer in Code

VB doesn't provide any way to determine where the mouse is regardless of which control its over. Neither does it allow you to move the cursor or emulate mouse clicks on objects. This tip provides a simple class which uses API functions to add this functionality.

Start a new project and add a Class module. Rename the class module to cMouse then add the following code

Option Explicit

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

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)
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:
   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 lFlagDown As Long
Dim lFlagUp As Long
   Select Case eButton
   Case vbRightButton
      lFlagDown = MOUSEEVENTF_RIGHTDOWN
      lFlagUp = MOUSEEVENTF_RIGHTUP
   Case vbMiddleButton
      lFlagDown = MOUSEEVENTF_MIDDLEDOWN
      lFlagUp = MOUSEEVENTF_MIDDLEUP
   Case Else
      lFlagDown = MOUSEEVENTF_LEFTDOWN
      lFlagUp = MOUSEEVENTF_LEFTUP
   End Select
   ' A click = down then up
   mouse_event lFlagDown Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
   mouse_event lFlagUp Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0, 0
End Sub

To test out the code, add the following to your project's form:

• A label, named lblInfo
• Three command buttons in a control array, named cmdMove. Set the labels of the buttons to
  1. 0,0
  2. 640,480
  3. 1024,768
• A command button named cmdClickFriend with the Caption "Click Ok"
• A command button named cmdOk with the Caption "OK"
• A timer named tmrThis with Interval set to 100

Then paste this code into the form:

Private Type RECT
   left As Long
   top As Long
   right As Long
   bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" ( _
   ByVal hwnd As Long, lpRect As RECT) As Long

Private m_cMouse As cMouse

Private Sub cmdClickFriend_Click()
Dim tR As RECT
   GetWindowRect cmdOK.hwnd, tR
   m_cMouse.MoveTo tR.left + (tR.right - tR.left) \ 2, _
      tR.top + (tR.bottom - tR.top) \ 2
   m_cMouse.Click
End Sub

Private Sub cmdMove_Click(Index As Integer)
   Select Case Index
   Case 0
      m_cMouse.MoveTo 0, 0
   Case 1
      m_cMouse.MoveTo 640, 480
   Case 2
      m_cMouse.MoveTo 1024, 768
   End Select
End Sub

Private Sub cmdOK_Click()
   Unload Me
End Sub

Private Sub Form_Load()
   Set m_cMouse = New cMouse
End Sub

Private Sub tmrThis_Timer()
   lblInfo.Caption = m_cMouse.x & "," & m_cMouse.y
End Sub

Run the project. As the timer fires, the label's caption will be updated with the current mouse position. When you click any of the cmdMoveTo buttons, the mouse will be physically moved to the new location. Finally, clicking the "Click OK" button will cause the cmdOK button to be pressed, causing the form to close.