"Chycení" myši do formuláře

Postup:
V modulu deklarujte:

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 
   Dim NewRect As RECT 

   CurForm.Caption = "Myš uvolněna" 
   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 
   Dim NewRect As RECT 

   'ScaleMode formuláře musí být nastaveno na Twips!!! 
   x& = Screen.TwipsPerPixelX 
   y& = Screen.TwipsPerPixelY 

   CurForm.Caption = "Myš chycena" 
   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

Na formulář přidejte dvě tlačítka a nastavte jeho ScaleMode na Twips. Na události Click tlačítek zapište:

Private Sub Command1_Click() 

   EnableTrap Form1 

End Sub 

Private Sub Command2_Click() 

   DisableTrap Form1 

End Sub 

Private Sub Form_Unload(Cancel As Integer) 

   'Při uzavírání aplikace je třeba uvolnit myš 
   DisableTrap Form1 

End Sub

Zpět