TrapMouse




'1) Add the following code to a module.


Option Explicit
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function ClipCursor Lib "user32" _
(lpRect As Any) As Long
Public Sub DisableTrap(CurForm As Form)
Dim erg As Long
'Declare a variable for the procedure

'to set the new coordinates

Dim NewRect As RECT
CurForm.Caption = "Mouse released"
'Set the new coordinates to full screen

With NewRect
.Left = 0&
.Top = 0&
.Right = Screen.Width / Screen.TwipsPerPixelX
.Bottom = Screen.Height / Screen.TwipsPerPixelY
End With
erg& = ClipCursor(NewRect)
End Sub

Public Sub EnableTrap(CurForm As Form)
Dim x As Long, y As Long, erg As Long
'Declare a variable for the procedure

'to set the new coordinates

Dim NewRect As RECT
'Get the TwipsperPixel

'The Form's ScaleMode must be set to Twips!!!

x& = Screen.TwipsPerPixelX
y& = Screen.TwipsPerPixelY
CurForm.Caption = "Mouse trapped"
'Set the Cursor-Region to the coordinates

'of the form

With NewRect
.Left = CurForm.Left / x&
.Top = CurForm.Top / y&
.Right = .Left + CurForm.Width / x&
.Bottom = .Top + CurForm.Height / y&
End With
erg& = ClipCursor(NewRect)
End Sub

'Form Code

'2. Two command buttons to Form1

'3. Add the Following code to Form1


Private Sub Command1_Click()
EnableTrap Form1
End Sub

Private Sub Command2_Click()
DisableTrap Form1
End Sub

Private Sub Form_Unload(Cancel As Integer)
'App is closed -> release the mouse!!

DisableTrap Form1
End Sub











( trapmouse.html )- by Paolo Puglisi - Modifica del 17/12/2023