Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0130: RubberRectangle - Auswahlrechteck zeichnen mit der Controlpaint-Klasse.

 von 

Beschreibung

Eine Besonderheit der vielen Zeichenfunktionen der Controlpaint-Klasse stellen die reversiblen Zeichenfunktionen dar. Diese können dazu verwendet werden, einfach auf den Bildschirm zu zeichnen und sind nicht an das Graphics-Objekt eines bestimmten Steuerelements gebunden. Daher können hiermit auch Zeichnungen über mehrere Steuerelemente hinweg dargestellt werden. Dies ist nützlich um temporäre Markierungen auszuführen, beispielsweise um etwa Drag'n'Drop-Ziele zu markieren oder, wie hier, ein Auswahlrechteck anzuzeigen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Framework-Version(en):

.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Compact Framework 1.0, .NET Compact Framework 2.0, .NET Framework 4

.NET-Version(en):

Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010

Download:

Download des Beispielprojektes [13,32 KB]

' 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!

' Projektversion:   Visual Studio 2005
' Option Strict:    An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - Microsoft.VisualBasic.ControlChars
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ########################### frmRubberRectangle.vb ############################
' ##############################################################################
Public Class frmRubberRectangle

    Private _rubberRect As New RubberRectangle()

    Private _Selection As Rectangle = Rectangle.Empty

    Private Sub frmRubberRectangle_MouseDown(ByVal sender As Object, _
            ByVal e As MouseEventArgs) Handles MyBase.MouseDown

        _rubberRect.Start(sender, e)
    End Sub

    Private Sub frmRubberRectangle_MouseUp(ByVal sender As Object, _
            ByVal e As MouseEventArgs) Handles MyBase.MouseUp

        If e.Button <> MouseButtons.Left Then Return
        If Not _Selection.IsEmpty Then Invalidate(_Selection)
        _Selection = Me.RectangleToClient(_rubberRect.Rectangle)
        Invalidate(_Selection)
    End Sub

    ' Nur zur Anzeige des ausgewählten Rechtecks.
    Protected Overloads Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)

        ' Button.Enabled wird nicht in Form_MouseUp() gesetzt, weil das die 
        '  RubberRectangle-Zeichnung stört, falls letztere über dem Button liegt
        btClearSelection.Enabled = Not _Selection.IsEmpty
        If _Selection.IsEmpty Then Return
        Dim rct As Rectangle = _Selection

        ' Bei Stiftbreite 1 muss das Rechteck 1 kleiner sein. Da die 
        '  Stiftposition beim Zeichnen aufgerundet wird läge sie ansonsten 
        '  außerhalb des Zeichenbereiches.
        rct.Size -= New Size(1, 1)
        e.Graphics.DrawRectangle(Pens.Red, rct)
    End Sub

    Private Sub btClearSelection_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles btClearSelection.Click

        Me.Invalidate(_Selection)
        _Selection = Rectangle.Empty
    End Sub

End Class

' ##############################################################################
' ############################ RubberRectangle.vb ##############################
' ##############################################################################
Imports System.Drawing
Imports System.Windows.Forms

' Reversibles Zeichnen (DrawReversibleFrame(), DrawReversibleLine(), 
' FillReversibleRectangle() zeichnet Umkehrwerte der bestehenden 
' Bildschirm-Pixel. Infolgedessen ist zum Löschen einfach exakt dieselbe 
' Zeichnung zu wiederholen
'
' Vorteil ist auch: Durch FarbInversion gezeichnete Linien sind auf 
'  jedem Untergrund sichtbar
' Nachteil: In einigen Szenarien kann ein normaler Zeichenvorgang den 
'  reversiblen übermalen. Will sich nun der Reversible durch Neuzeichnung 
'  löschen, so wird er erst erneut sichtbar, und verbleibt als unerwünschter 
'  Zeichnungsrest.

Public Class RubberRectangle

    Private _Rectangle As Rectangle
    Private _anchor As Size

    ''' <summary> das Auswahlrechteck in BildschirmKoordinaten </summary>
    Public ReadOnly Property Rectangle() As Rectangle
        Get
            Dim rct As Rectangle = _Rectangle
            ' DrawReversibleFrame verarbeitet zwar auch Rechtecke mit negativer 
            '  Breite oder Höhe, aber doch lieber umrechnen. 
            If rct.Width < 0 Then
                rct.X += rct.Width
                rct.Width = -rct.Width
            End If
            If rct.Height < 0 Then
                rct.Y += rct.Height
                rct.Height = -rct.Height
            End If
            Return rct
        End Get
    End Property

    Public Sub Start(ByVal sender As Object, ByVal e As MouseEventArgs)
        If e.Button <> MouseButtons.Left Then _
            Throw New ArgumentException( _
                "Rubberband darf nur bei gedrückter linker Maustaste " & _
                "gestartet werden", "e.Button")

        _Rectangle = New Rectangle(Control.MousePosition, Size.Empty)
        _anchor = New Size(Rectangle.X, Rectangle.Y)

        ' Erstmaliges Zeichnen
        DrawRect()

        Dim ctl As Control = DirectCast(sender, Control)
        AddHandler ctl.MouseMove, AddressOf ctl_MouseMove
        AddHandler ctl.MouseUp, AddressOf ctl_MouseUp
    End Sub

    Private Sub ctl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
        ' Löschen
        DrawRect()

        Dim pt As Point = Control.MousePosition
        _Rectangle.Size = New Size(pt - _anchor)

        ' Neuzeichnen
        DrawRect()
    End Sub

    Private Sub ctl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
        ' Letztmaliges Löschen
        DrawRect()

        Dim ctl As Control = DirectCast(sender, Control)
        RemoveHandler ctl.MouseMove, AddressOf ctl_MouseMove
        RemoveHandler ctl.MouseUp, AddressOf ctl_MouseUp
    End Sub

    Private Sub DrawRect()
        ControlPaint.DrawReversibleFrame(_Rectangle, _
            Color.Yellow, FrameStyle.Thick)
    End Sub

End Class

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.