Tipp 0017 Mauscursorbereich eingrenzen
Autor/Einsender:
Datum:
  Detlev Schubert
15.01.2001
Entwicklungsumgebung:   VB 5
Gelegentlich ist es schon ganz hilfreich, die Bewegungsfreiheit des Mauscursors einzugrenzen, um den Anwender daran zu hindern, auf bestimmte Bereiche des Bildschirms zu klicken. Dafür steht die API-Funktion ClipCursor zur Verfügung, die den Cursorbereich auf einen bestimmten rechteckigen Bildschirmbereich beschränkt, aus dem der Mauscursor nicht herausbewegt werden kann, bis er wieder freigegeben wird. Die Grenzen, werden durch eine RECT-Struktur festgelegt.
Hinweis
Die Begrenzung des Mauscursors muss beim Beenden des Programms mit ClipCursor 0 wieder aufgehoben werden, da sonst ein Neustart unumgänglich ist.
Code im Codebereich des Moduls
 
Option Explicit

#If Win16 Then
    Type POINTAPI
      x As Integer
      y As Integer
    End Type

    Type RECT
      left As Integer
      top As Integer
      right As Integer
      bottom As Integer
    End Type

    Private Declare Sub ClipCursor Lib "User" (lpRect As Any)

    Private Declare Sub GetClientRect Lib "User" (ByVal hWnd _
            As Integer, lpRect As Any)

    Private Declare Sub ClientToScreen Lib "User" (ByVal hWnd _
            As Integer, _
            lpPoint As POINTAPI)

    Private Declare Function GetDesktopWindow Lib "User" () _
            As Integer

#Else
    Type POINTAPI
      x As Long
      y As Long
    End Type

    Type RECT
      left As Long
      top As Long
      right As Long
      bottom As Long
    End Type

    Private Declare Function ClipCursor Lib "user32" (lpRect _
            As Any) As Long

    Private Declare Function GetClientRect Lib "user32" (ByVal _
            hWnd As Long, lpRect As RECT) As Long

    Private Declare Function ClientToScreen Lib "user32" (ByVal _
            hWnd As Long, lpPoint As POINTAPI) As Long

    Private Declare Function GetDesktopWindow Lib "user32" () _
            As Long
#End If

Private Function GetScreenRect(Obj As Object) As RECT
  Dim Pt As POINTAPI, Rct As RECT

  GetClientRect Obj.hWnd, Rct

  Pt.x = Rct.left
  Pt.y = Rct.top
  ClientToScreen Obj.hWnd, Pt
  GetScreenRect.left = Pt.x
  GetScreenRect.top = Pt.y

  Pt.x = Rct.right
  Pt.y = Rct.bottom
  ClientToScreen Obj.hWnd, Pt
  GetScreenRect.right = Pt.x
  GetScreenRect.bottom = Pt.y
End Function

Sub SetClip(Obj As Object, OK)
  Dim Rct As RECT

  Select Case OK
    Case True
      Rct = GetScreenRect(Obj)
      ClipCursor Rct
    Case Else
      GetClientRect GetDesktopWindow(), Rct
      ClipCursor Rct
  End Select
End Sub
 
Code im Codebereich der Form
 
Option Explicit

Private OK As Boolean

Private Sub Command1_Click(index As Integer)
  Select Case index
    Case 1
      OK = OK Xor -1
      SetClip Command1(1), OK
    Case Else
      Unload Me
      End
  End Select
End Sub

Private Sub Form_Click()
  OK = OK Xor -1
  SetClip Me, OK
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode _
        As Integer)
  SetClip Me, False
End Sub

Private Sub Label1_Click()
  Form_Click
End Sub

Private Sub Picture1_Click()
  OK = OK Xor -1
  SetClip Picture1, OK
End Sub
 
Weitere Links zum Thema
Maus-Cursor verstecken
Mausklick simulieren
Position des Maus-Cursors ermitteln

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (2,7 kB) Downloads bisher: [ 1578 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 28. August 2011