Mouse

[YAMMY]

Hi, everybody,

Does any one know is there any API call can restrict the mouse pointer activity only available in my form ?, i.e. when running my application, the mouse cannot go outside of my form.

Thanks a lots!
Regards,
Yammy

Use the ClipCursor api function.

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


Usage


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

You can shorten it down to...

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Dim RT As RECT

Function TrapCursor()
GetWindowRect hwnd, RT
ClipCursor RT
End Function

Function UnTrapCursor()
GetWindowRect GetDesktopWindow, RT
ClipCursor RT
End Function

Private Sub Command1_Click()
TrapCursor 'Trap the MousePointer
End Sub

Private Sub Command2_Click()
UnTrapCursor 'Release the cursor
End Sub