VB and VBA Users Source Code: Restrict the movement of a cursor to a specified area
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Restrict the movement of a cursor to a specified area
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, February 23, 2001
Hits:
662
Category:
Windows API
Article:
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 'Author : Andrew Baker 'Date : 31/12/2000 13:51 '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. 'Revisions : 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 'Author : Andrew Baker 'Date : 31/12/2000 13:51 'Notes : 'Revisions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
