Startseite / Tipps / VB 5/6-Tipp 0179: Den Mausbereich einschränken

VB 5/6-Tipp 0179: Den Mausbereich einschränken

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command1" auf Picture1
' Steuerelement: Schaltfläche "Command2" auf Picture1

Option Explicit

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

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Declare Sub ClipCursor Lib "user32" (ByVal lpRect As Long)

Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd _
        As Long, lpRect As RECT)
        
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd _
        As Long, lpPoint As POINTAPI)
        
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, _
        ByVal x As Long, ByVal y As Long)

Private Sub Command1_Click()
    Dim RPic As RECT
    Dim ul As POINTAPI

    Call GetClientRect(Picture1.hWnd, RPic)
    Call ClientToScreen(Picture1.hWnd, ul)
    
    Call OffsetRect(RPic, ul.x, ul.y)
    Call ClipCursor(VarPtr(RPic))
End Sub

Private Sub Command2_Click()
    Call ClipCursor(ByVal 0&)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call ClipCursor(ByVal 0&)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

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


Private Sub Command1_Click()
    Dim RPic As RECT
    Dim ul As POINTAPI

    Call GetClientRect(Picture1.hWnd, RPic)  'schreibt Höhe und Breite von Picture1 nach RPic.bottom und RPic.Right
'    ul.x = RPic.left           'Das Setzen von ul.x, ul.y bringt nix, dafür ist die API "ClientToScreen" zuständig
'    ul.y = RPic.top
       
    Call ClientToScreen(Picture1.hWnd, ul)  'schreibt Left und Top von Picture1 (die Offset-Größen) nach ul.x, ul.y
    Call OffsetRect(RPic, ul.x, ul.y)                     'verschiebt RPic um ul (d.h. an die Position von Picture1)
    Call ClipCursor(RPic)
End Sub