Visual Basic Programming Code Examples

Visual Basic > API and Miscellaneous Code Examples

Restrict the movement of a cursor to a specified area



Restrict the movement of a cursor to a specified area

The following code restricts the mouse/cursor's movement to a specified area.

Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type

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

Private Declare Sub ClipCursorRect Lib "user32" Alias "ClipCursor" (lpRect As RECT)
Private Declare Sub ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

'Purpose     :  Restricts the cursors movement to the specified coordinates
'Inputs      :  lLeft                   The left area to restrict the mouse move to.
'               lTop                    The top area to restrict the mouse move to.
'               lLeft                   The width of the area to restrict the mouse move to.
'               lLeft                   The height of the area to restrict the mouse move to.
'Outputs     :  N/A
'Notes       :  If the user switches to another application, the clipping cursor is cleared.
'               If you wish this behaviour to persist then you can place the code in the Form_Paint event.


Public Sub CursorClip(ByVal lLeft As Long, ByVal lTop As Long, ByVal lWidth As Long, ByVal lHeight As Long)
    Dim tR As RECT
    Dim tP As POINTAPI
    
    'Convert positions into a rectangle in pixels
    tR.Left = lLeft \ Screen.TwipsPerPixelX
    tR.Top = lTop \ Screen.TwipsPerPixelY
    tR.Right = (lLeft + lWidth) \ Screen.TwipsPerPixelX
    tR.Bottom = (lLeft + lHeight) \ Screen.TwipsPerPixelY
    'Set the cursor clipping rectangle
    Call ClipCursorRect(tR)
End Sub


'Purpose     :  Clears any restricts on the cursors movement
'Inputs      :  N/A
'Outputs     :  N/A


Public Sub CursorRestore()
   Call ClipCursorClear(0&)
End Sub


'Demonstration code (place in form)
Private Sub Form_Load()
    CursorClip Me.Left, Me.Top, Me.Width, Me.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CursorRestore
End Sub