Bildbearbeitung mit GDI+ Visual Basic stellt im Namespace 'Drawing' eine Vielzahl von Funktionen zur Verfügung, die für die Bildbearbeitung von großem Nutzen sind. Die Anwendung dieser Verfahren ist etwas gewöhnungsbedürftig. Die Routine PicCut aus diesem Workshop demonstriert den Umgang mit Bild-Ausschnitten. Sie ist so programmiert, dass sie auch direkt in eigene Anwendungen übernommen werden kann.
Autor:  Manfred Bohn	Bewertung:	Views:  17.562

Folgende Funktionen sind verfügbar:

• Verschieben bzw. Kopieren eines frei wählbaren Bild-Ausschnitts
• Anpassung des Pixelformats an das Zielbild
• Vergrößern und Verkleinern des Bildausschnitts (Zoomen)
• Drehung des Ausschnitts um das eigene Zentrum bei frei wählbarem Winkel
• Zuschneiden des Ausschnitts (als Ellipse, Kreis oder Vieleck)
• Helligkeitsänderung des Ausschnitts

Die Routine ist als Erweiterungsmethode für das Bitmap-Objekt (Quell-Bild) verwendbar.

Gestaltung der Funktions-Parameter
Quell- und Zielbild werden jeweils als Bitmap-Objekt erwartet. Falls kein Zielbild angegeben wird, erfolgt die Eintragung des Bildausschnitts in das Quell-Bild. Bei unterschiedlichen Pixelformaten im Quell- und Ziel-Bild wird das Format des Bildausschnitts angepasst (d.h. es kann zu einem Informationsverlust kommen).

Position (Top, Left) und Größe (Width, Height) des Bildausschnitts werden über eine Rectangle-Struktur (source_rect) vorgegeben (Einheit: Pixel). Falls das Ausschnitt-Rechteck teilweise außerhalb des Quell-Bildes liegt, wird es entsprechend verkleinert (Routine: 'Adjust_Rect').

Auch Position und Größe des Ausschnitts im Ziel-Bild werden durch ein Rectangle festgelegt (destination_source). Bei der Übertragung in das Zielbild wird das Seitenverhältnis beibehalten (also kein Stretch, sondern Zoom, vgl. Routine: 'Zoom_Rect'). Der Bildausschnitt wird ggf. im Ziel-Rechteck zentriert eingepasst. Die Größe des Ziel-Rechtecks gibt vor, ob eine Vergrößerung oder Verkleinerung des Ausschnitts erfolgt. Falls das Zielrechteck (teilweise) außerhalb der Abmessungen des Ziel-Bildes liegt, wird nur der innerhalb liegende Teil des Bildausschnitts gezeichnet - eventuell wird also nichts gezeichnet!

Der Parameter corners gibt die Zahl der Ecken des Ausschnitts im Ziel-Bild an. Falls er 0 ist, wird eine Ellipse bzw. ein Kreis gezeichnet. Falls er größer zwei, aber ungleich vier gewählt wird, wird ein regelmäßiges Vieleck gezeichnet - falls der Bildausschnitt quadratisch ist (d.h. in 'source_rect': Width = Height). Sonst werden die Ecken 'elliptisch' angeordnet. Bei Corners = 4 wird das gesamte 'source_rect' als Quadrat oder als Rechteck ins Ziel übertragen. Alle anderen Werte von 'Corners' führen zur Definition einer entsprechenden 'Region' (Ellipse oder Polygon; Klasse 'GraphicsPath'), für die das Quell-Rechteck nur die äußere Begrenzung darstellt. In diesen Fällen sollte das 'source_rect' deshalb etwas größer gewählt werden.

Der Parameter Angle gibt einen Winkel (in Grad) an, um den der Bildausschnitt gedreht wird. Positive Werte drehen nach rechts, negative nach links. Der Wert des Parameters sollte im Bereich +/-360 liegen. Die Drehung erfolgt um die Mitte des Ausschnitts (Klasse: 'Matrix'; Methode: 'RotateAt').

Der Parameter Start wird nur beachtet, wenn 'corners' <> 0 und 'corners' <> 4 gewählt ist. Durch diesen Parameter wird beim Vieleck gesteuert, in welchem Winkel die erste Ecke auf der umschließenden Ellipse angeordnet ist (Routine: 'Ellipsen_Punkte').

Der Parameter darkness bestimmt, ob eine Helligkeitsänderung vorgenommen wird (0: keine Änderung, >0: Aufhellung, <0: Abdunkelung). Dieser Parameter steuert eine Farb-Transformationsmatrix (Klasse: 'Colormatrix'; Klasse: 'ImageAttributes'). Bereits kleine Werte führen in diesem Parameter zu erheblichen Helligkeitsänderungen. Praktisch sinnvoll sind Werte zwischen +/-0.3.

Wichtige Details

1. Das GDI-System scheint keine Bilder mit indiziertem Pixelformat zu akzeptieren. Auch bei diesen beiden Formaten sind GDI-Fehler aufgetreten: Format16bppArgb1555, Format16bppGrayScale
   Für alle anderen von VB unterstützen Pixelformate ist die Routine 'PicCut' offenbar verwendbar.
   Beim Laden der Bilder mit der Routine 'LoadPic' wird deshalb ggf. eine Anpassung des Formats und eine Neuzeichnung des Bildes vorgenommen. Bild-Dateien sollten grundsätzlich mit dieser Routine geladen werden.
    
2. Die Verwendung von Klassen im System.Drawing.Imaging-Namespace mit einem Dienst von Windows oder ASP.NET wird nicht unterstützt. Wenn Sie diese Klassen in einem der genannten Anwendungstypen verwenden, kann dies unerwartete Probleme zur Folge haben, z. B. Leistungsbeeinträchtigungen und Laufzeitausnahmen. (VB-Dokumentation).
    
3. Bei der Skalierung und Drehung des Bildausschnitts wird für die Berechnung der Position die Interpolationsmethode verwendet, die das beste Ergebnis beim höchstem Bedarf an Rechenzeit liefert ('HighQualityBicubic'). Für die schnelle Bearbeitung von Bilderserien geringer Qualität können andere Einstellungen zweckmäßig sein.
    
4. Bei der Kombination verschiedener Graphik-Methoden ist die Reihenfolge der Registrierung im Graphics-Objekt von Bedeutung. In der Routine 'PicCut' wird zunächst die Rotations-Matrix registriert, danach - falls erforderlich - der 'ClipPath'. Auf diese Weise wird die Form der 'Region' zusammen mit dem Bild-Ausschnitt gedreht. Im umgekehrten Fall würde nur das Bild gedreht, die Position der Ecken bliebe konstant.

Um einen besseren Überblick zu geben, sind die Deklarationen und Aufrufe (abgesehen vom Namespace 'System') im Quellcode voll qualifiziert angegeben.

Das Anwendungsbeispiel demonstriert die Wirkung der Parameter der 'PicCut' Routine. Es erstellt vier verschieden geformte, gedrehte (z.T. aufgehellte) Bildausschnitte, deren Gesamtgröße an die Picturebox angepasst ist (Zoom).

Ausführung des Anwendungsbeispiel

1. Erstellen Sie ein neues Projekt.
2. Kopieren Sie den Code des Anwendungsbeispiels in das Formular (Form1).
3. Fügen Sie dem Projekt eine neue Modul-Datei hinzu und kopieren Sie den Code des Moduls 'modPicCut'.
4. Weisen Sie der String-Variable 'FileName' in der Ereignis-Routine 'Form1_Load' den Pfad und den Namen einer Bilddatei zu.
5. Starten Sie den Debugger

' =====================================================================
' Anwendungbeispiel
' =====================================================================
 
''' <summary>
''' Anwendungsbeispiel für Routine 'PicCut'
''' Variable 'Filename': Name und Pfad einer Bild-Datei angeben
''' (Format: mindestens 16 Bits/Pixel)
''' </summary>
Public Class Form1
  ' Picturebox zur Anzeige der Bildausschnitte
  Dim WithEvents PictureBox1 As New Windows.Forms.PictureBox
 
  Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
 
    Dim Filename As String = _
      Application.StartupPath & "\testbild.jpg"
 
    ' Deklaration der Variablen für Bitmaps und Rectangles
    Dim Meldung As String = ""
    Dim source_bitmap As Drawing.Bitmap
    Dim destination_bitmap As Drawing.Bitmap
    Dim source_rect As Drawing.Rectangle
    Dim destination_rect As Drawing.Rectangle
 
    ' Formular einrichten
    With Me
      .Visible = False
      .Text = "Demonstration 'PicMove' (Bildausschnitte)"
      .Width = 700 : .Height = 700
      .FormBorderStyle = _
      Windows.Forms.FormBorderStyle.Fixed3D
      .Controls.Add(PictureBox1)
    End With
 
    With PictureBox1
      ' PictureBox einrichten
      .BorderStyle = BorderStyle.Fixed3D
      .Top = 10 : .Left = 10
      .Width = Me.Width - 20
      .Height = Me.Height - 50
      .SizeMode = PictureBoxSizeMode.Zoom
 
      ' Bilddatei laden (Extension Method)
      If Not .Image.LoadPic(Filename, Meldung) Then
        ' Falls beim Laden des Bildes etwas schiefgeht 
        MsgBox(Meldung, MsgBoxStyle.Exclamation)
        Exit Sub
      End If
      source_bitmap = CType(.Image, Drawing.Bitmap)
    End With
 
    ' Mittleren Bereich der Quell-Bitmap 
    ' als Bildausschnitt definieren
    With source_bitmap
      ' relative Größe des Bildausschnitts 
      ' (im Bereich 0.1 <-> 1.0)
      Dim fak As Double = 0.6
 
      source_rect = New Drawing.Rectangle( _
        CInt((1 - fak) / 2 * .Width), _
        CInt((1 - fak) / 2 * .Height), _
        CInt(fak * .Width), CInt(fak * .Height))
 
      ' Ziel-Bitmap in PBox-Größe erstellen
      destination_bitmap = New Bitmap(PictureBox1.Width, _
        PictureBox1.Height, .PixelFormat)
    End With
 
    ' Ziel-Bitmap mit weisser Farbe füllen
    Dim g As Drawing.Graphics = _
      Drawing.Graphics.FromImage(destination_bitmap)
    With destination_bitmap
      g.FillRectangle(Brushes.White, 0, 0, .Width, .Height)
    End With
    ' Graphics-Objekt freigeben
    g.Dispose()
 
    ' Linkes oberes Viertel im Ziel-Rechteck 
    With destination_bitmap
      destination_rect = New Rectangle(0, 0, .Width \ 2, .Height \ 2)
    End With
 
    ' Ellipse ausgeben
    ' (Aufruf von 'PicCut' als modulare Routine) 
    PicCut(source_bitmap, source_rect, _
      destination_bitmap, destination_rect, 0, -45)
 
    ' Rechtes oberes Viertel in Ziel-Bitmap
    With destination_bitmap
      destination_rect = New Rectangle _
        (.Width \ 2, 0, .Width \ 2, .Height \ 2)
    End With
 
    ' Dreieck ausgeben
    ' (Aufruf von 'PicCut' als Extension Method [ab VB2008])
    source_bitmap.PicCut(source_rect, _
      destination_bitmap, destination_rect, 3, 45, 40)
 
    ' Linkes unteres Viertel in Ziel-Bitmap
    With destination_bitmap
      destination_rect = New Rectangle _
        (CInt(0.1 * .Height), CInt(1.2 * .Height / 2), _
        .Width \ 3, .Height \ 3)
    End With
 
    ' Rechteck ausgeben (etwas aufgehellt)
    source_bitmap.PicCut(source_rect, _
      destination_bitmap, destination_rect, 4, -135, , 0.09)
 
    ' Rechtes unteres Viertel in Ziel-Bitmap
    With destination_bitmap
      destination_rect = New Rectangle _
        (.Width \ 2, .Height \ 2, .Width \ 2, .Height \ 2)
    End With
 
    ' Achteck ausgeben (leicht abgedunkelt)
    source_bitmap.PicCut(source_rect, _
      destination_bitmap, destination_rect, 8, 135, 20, -0.09)
 
    ' Das Ziel-Bild mit den Auasschnitten in der 
    ' PictureBox anzeigen
    PictureBox1.Image = destination_bitmap
    Me.Visible = True
  End Sub
End Class

Das Modul "modPicCut"

''' <summary>
''' Bearbeitung von Bildausschnitten (Form: Ellipse, Vieleck)
''' Verschieben, Kopieren, Drehen, Zoomen, Helligkeitsänderung
''' Manfred Bohn für VBARCHIV (Juni 2008)
''' (Visual Basic 2008)
''' </summary>
Module modPicCut
 
  ''' <summary>
  ''' einen viel-eckigen Bildausschnitt 
  ''' positionieren, zoomen und drehen
  ''' </summary>
  ''' <param name="source_bitmap">Quell_Bild</param>
  ''' <param name="source_rect">Position und Größe des
  ''' Ausschnitts im Quell-Bild</param>
  ''' <param name="destination_bitmap">Ziel-Bild</param>
  ''' <param name="destination_rect">
  ''' Position und Größe des Ausschnitts im Ziel-Bild</param> 
  ''' <param name="corners">Zahl der Ecken (drei bis 20)</param>
  ''' <param name="angle">Drehwinkel Bildausschnitt (in Grad)</param>
  ''' <param name="start">Startwinkel der Ecken (in Grad),
  ''' falls Corners ungleich vier</param>
  ''' <param name="darkness">Darkness</param>
  ''' <returns>Alles OK?</returns>
  <System.Runtime.CompilerServices.Extension()> _
  Public Function PicCut( _
    ByVal source_bitmap As Drawing.Bitmap, _
    ByVal source_rect As Drawing.Rectangle, _
    ByRef destination_bitmap As Drawing.Bitmap, _
    ByVal destination_rect As Drawing.Rectangle, _
    Optional ByVal corners As Integer = 4, _
    Optional ByVal angle As Integer = 0, _
    Optional ByVal start As Integer = 0, _
    Optional ByVal darkness As Double = 0) As Boolean
 
    Try
      If IsNothing(source_bitmap) Then Return False
 
      ' Bei fehlendem Zielbild wird in das Quellbild gezeichnet
      If IsNothing(destination_bitmap) Then
        destination_bitmap = source_bitmap
      End If
 
      ' Bildausschnitt muss innerhalb des Bildes liegen
      ' falls nötig, erfolgt Anpassung durch Verkleinerung 
      ' des Ausschnitts
      If Not Adjust_Rect(source_bitmap, source_rect) Then
        Return False
      End If
 
      ' Das Seitenverhältnis beim Zoomen beibehalten
      If Not Zoom_Rect(source_rect, destination_rect) Then
        Return False
      End If
 
      ' Bitmap für den Bildausschnitt erstellen
      ' (Pixelformat an Zielbild angepasst)
      Dim cut_bitmap As New Drawing.Bitmap( _
        source_rect.Width, source_rect.Height, _
        destination_bitmap.PixelFormat)
 
      '  Bildaussschnitt in cut_bitmap zeichnen
      Dim g As Drawing.Graphics = _
      Drawing.Graphics.FromImage(cut_bitmap)
      g.DrawImage(source_bitmap, 0, 0, source_rect, _
        GraphicsUnit.Pixel)
      g.Dispose()
 
      '  Graphics-Objekt für Ziel-Bild erstellen
      g = Drawing.Graphics.FromImage(destination_bitmap)
 
      ' Beste Qualität der Ziel-Pixelberechnung
      '  beim Drehen und Skalieren
      g.InterpolationMode = _
        Drawing2D.InterpolationMode.HighQualityBicubic
 
      ' Drehmatrix für den Winkel erstellen
      ' (Drehung um die Mitte des Bildausschnitts)
      Dim matrix As New Drawing.Drawing2D.Matrix
      Dim p As Drawing.Point
      With destination_rect
        p.X = .Left + .Width \ 2
        p.Y = .Top + .Height \ 2
      End With
      ' Rotationsmatrix definieren
      matrix.RotateAt(angle, p)
      ' Matrix registrieren
      g.Transform = matrix
 
      If corners <> 4 Then
        ' Region für Ausschnitt im Ziel-Bild erforderlich
        Dim clip As New Drawing.Drawing2D.GraphicsPath
        If corners = 0 Then
          ' Ellipsenförmige Region erstellen
          clip.AddEllipse(destination_rect)
        Else
          ' Viel-Eckige Region erstellen
          ' Die Position der Ecken des Viel-Ecks berechnen
          If Not Ellipsen_Punkte _
            (destination_rect, corners, start, clip) _
            Then Return False
        End If
 
        ' Region registrieren
        g.SetClip(clip)
        ' ClipPath freigeben
        clip.Dispose()
      End If
 
      Dim imgattr As New Drawing.Imaging.ImageAttributes()
      If darkness <> 0 Then
        ' extreme Parameter ggf. anpassen
        If darkness < -0.5 Then darkness = -0.5
        If darkness > 0.5 Then darkness = 0.5
        ' Helligkeit des Bildausschnitts ändern
        Dim cm(0)() As Single
        ' Farb-Transformationsmatrix erstellen
        Color_Matrix(CSng(darkness), cm)
        Dim colMat As New Drawing.Imaging.ColorMatrix(cm)
        imgattr.SetColorMatrix(colMat, _
          Drawing.Imaging.ColorMatrixFlag.Default, _
          Drawing.Imaging.ColorAdjustType.Bitmap)
      End If
 
      ' Bildausschnitt an die Ziel-Position 
      ' im Ziel-Bild zeichnen (gedreht & regioned)
      If darkness = 0 Then
        g.DrawImage(cut_bitmap, destination_rect)
      Else
        ' zusätzlich: Helligkeitsänderung gewünscht
        g.DrawImage(cut_bitmap, destination_rect, _
          0, 0, cut_bitmap.Width, cut_bitmap.Height, _
          GraphicsUnit.Pixel, imgattr)
      End If
 
      ' Graphik-Ressourcen explizit freigeben 
      matrix.Dispose() : g.Dispose() : cut_bitmap.Dispose()
      imgattr.Dispose()
      Return True
    Catch ex As Exception
      Return False
    End Try
  End Function

  Private Function Ellipsen_Punkte( _
    ByVal rect As Drawing.Rectangle, _
    ByVal Anzahl As Integer, _
    ByVal StartWinkel As Integer, _
    ByRef clip As Drawing.Drawing2D.GraphicsPath) As Boolean
 
    ' Punkte auf einer Ellipse, die durch 
    ' den Parameter 'rect' definiert ist
 
    ' Anzahl: angeforderte Zahl der Punkte
    ' StartWinkel: Position des ersten Punktes
 
    ' Rückgabe:
    ' clip: Polygon aus den Ellipsenpunkten
 
    clip.ClearMarkers()
    If Anzahl < 3 Or Anzahl > 20 Then Return False
    Dim p(Anzahl) As Drawing.Point
    Dim z As Integer = -1
    Dim wd As Double = (360 / Anzahl) * Math.PI / 180
    Dim w As Double = StartWinkel * Math.PI / 180 - wd
    Dim x As Integer = rect.Left + rect.Width \ 2
    Dim y As Integer = rect.Top + rect.Height \ 2
    For i As Integer = 1 To Anzahl
      z += 1
      w += wd
      p(z).X = x + CInt(rect.Width / 2 * Math.Cos(w))
      p(z).Y = y + CInt(rect.Width / 2 * Math.Sin(w)) _
        * rect.Height \ rect.Width
    Next i
    p(Anzahl) = p(0) ' Polygon schließen
 
    ' Rückgabe
    clip.AddPolygon(p)
    Return True
  End Function

  Private Function Adjust_Rect(ByVal bitmap As Drawing.Bitmap, _
    ByRef rect As Drawing.Rectangle) As Boolean
 
    ' Rectangle-Werte ggf. an die Abmessungen des
    ' Bitmap anpassen
    With rect
      Dim top As Integer = Math.Max(.Top, 0)
      Dim left As Integer = Math.Max(.Left, 0)
      Dim width As Integer = _
        Math.Min(.Width, bitmap.Width - left - 1)
      ' Mindestbreite?
      If width < 10 Then Return False
      Dim height As Integer = _
        Math.Min(.Height, bitmap.Height - top - 1)
      ' Mindesthöhe?
      If height < 10 Then Return False
      rect = New Drawing.Rectangle(left, top, width, height)
      Return True
    End With
  End Function

  Private Function Zoom_Rect( _
    ByVal source_rect As Drawing.Rectangle, _
    ByRef destination_rect As Drawing.Rectangle) As Boolean
 
    Try
      ' Hilfsfunktion: Zoomen (ohne Stretchen)
      ' Seitenverhältnis im Destination_Rectangle =
      ' Seitenverhältnis im Source_Rectangle setzen
      Dim dw, dh, dl, dt As Integer
      With source_rect
        dw = destination_rect.Width
        dh = CInt(destination_rect.Width * .Height / .Width)
        If dh > destination_rect.Height Then
          dh = destination_rect.Height
          dw = CInt(destination_rect.Height * .Width / .Height)
        End If
      End With
 
      With destination_rect
        dl = .Left : dt = .Top
        ' Zentrieren im Zielrechteck 
        dl += (.Width - dw) \ 2
        dt += (.Height - dh) \ 2
      End With
 
      ' Mindestgröße?
      If dw < 10 Or dh < 10 Then Return False
 
      ' angepasstes Zielrechteck zurückgeben
      destination_rect = New Drawing.Rectangle(dl, dt, dw, dh)
      Return True
    Catch
      Return False
    End Try
  End Function

  Private Sub Color_Matrix(ByVal fak As Single, _
    ByRef cm()() As Single)
 
    ' Erstellung einer Farbmatrix für die 
    ' Änderung der Bildhelligkeit
 
    ' Einheitsmatrix
    ReDim cm(4)
    For i As Integer = 0 To 4
      ReDim cm(i)(4)
      cm(i)(i) = 1
    Next i
    ' Parameterwert eintragen
    cm(4)(0) = fak
    cm(4)(1) = fak
    cm(4)(2) = fak
  End Sub

  ''' <summary>
  ''' Bilddatei laden
  ''' </summary>
  ''' <param name="Img">Geladenes Bild eingetragen wird</param>
  ''' <param name="Filename">Name der Bilddatei</param>
  ''' <returns>Alles OK?</returns>
  <System.Runtime.CompilerServices.Extension()> _
  Public Function LoadPic(ByRef Img As System.Drawing.Image, _
    ByVal Filename As String, _
    Optional ByRef Meldung As String = "") As Boolean
 
    Try
      Meldung = ""
      ' Laden eines Bildes unter Verwendung der in der
      ' Datei verzeichneten Angaben zum Farb-Management
      Dim fs As New IO.FileStream(Filename, _
        IO.FileMode.Open, IO.FileAccess.Read, _
        IO.FileShare.ReadWrite)
 
      ' Bild laden
      ' If IsNothing(Img) Then Exit Function
      Img = Image.FromStream(fs, True)
 
      ' Filestream schließen - File/Ressourcen freigeben
      fs.Close()
 
      Dim pf As Drawing.Imaging.PixelFormat
      Dim Str As String = Img.PixelFormat.ToString
 
      If InStr(UCase(Str), "INDEX") > 0 Or _
        InStr(UCase(Str), "GRAY") > 0 Or _
        InStr(UCase(Str), "1555") > 0 Then
        ' Falls das Format 'indiziert' ist
        pf = Imaging.PixelFormat.Format32bppArgb
      Else
        ' sonst wird das in der Datei eingetragene 
        ' Format akzeptiert
        pf = Img.PixelFormat
      End If
 
      ' Neuzeichnen ist nach dem Schließen des
      ' Filestreams immer sinnvoll .....
      Dim bmp As New Drawing.Bitmap(Img.Width, Img.Height, pf)
 
      Dim g As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
      g.DrawImage(Img, 0, 0, Img.Width, Img.Height)
      g.Dispose()
 
      ' Rückgabe
      Img = CType(bmp.Clone, Drawing.Image)
 
      bmp.Dispose()
      Return True
    Catch ex As Exception
      Meldung = ex.Message
      Return False
    End Try
  End Function

End Module

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.