Direkte Manipulation von Bilddaten (VB 2005) VB 2005 hält im Namespace 'System.Drawing' bzw. 'System.Drawing.Graphics' eine Vielzahl von Funktionen zum Bearbeiten von Bildern und zum Zeichnen bereit. Der Zugriff auf einzelne Pixel via GetPixel/SetPixel ist bei einer großen Anzahl von Bearbeitungen jedoch viel zu langsam!
Autor:  Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  20.855

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 6 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 5.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Problemstellung:
VB 2005 hält im Namespace 'System.Drawing' bzw. 'System.Drawing.Graphics' eine Vielzahl von Funktionen zum Bearbeiten von Bildern und zum Zeichnen bereit. Für den Zugriff auf einzelne Pixel einer geladenen Bitmap stehen die Methoden 'Getpixel' und 'Setpixel' zur Verfügung.

Will man eine große Anzahl von Pixeln durch selbst-programmierte Verfahren bearbeiten, sind Bilddaten-Zugriffe durch diese beiden Methoden aber zu langsam.

Man kann deshalb die 'verwalteten' Pixeldaten im Speicher sperren und dann per 'Interop.Marshaling' in ein eindimensionales VB-Array kopieren. Damit wird ein rascher Zugriff auf die Farb-Bytes der einzelnen Pixel möglich. Die VB-Dokumentation enthält die Routine 'LockUnlockBitsExample', bei der demonstriert wird, wie man dabei vorgehen muss. (Dieses Beispiel funktioniert nur bei Bitmaps, deren Format 24 Bits/Pixel umfasst.)

Um die Vorgehensweise anschaulicher zu machen, wird die Routine 'Pixel_Manipulation' vorgestellt, die als Parameter den Pfad einer Bilddatei und eine Zieldatei für die modifizierten Bilddaten erwartet.

Folgende Funktionen sind ergänzt worden:

• Laden und Speichern (verschiedene Formate) eines Bildes
• Umwandlung einer Bitmap in eine 24-Bit-Bitmap
• Zugriff auf die Array-Daten durch eine pixelbezogene Doppelschleife
• Beispiele für Pixel-Konvertierungen (Helligkeit, Kontrast, Farb-Invertierung)
• Beispiele für Farb-Manipulation (Grautöne, Austausch der Farb-Intensität)

Abgesehen vom Namespace 'System', sind im Demo-Code die Objekte, Eigenschaften und Methoden 'voll qualifiziert', damit man sich besser zurechtfinden kann.
Liste der verwendeten NameSpaces:

• Drawing
• Drawing.Imaging
• Drawing.Graphics
• Runtime.InteropServices.Marshal

Um die Routine 'Pixel_Manipulation' auszuführen, sollte man seinem Projekt ein neues Modul hinzufügen und den gesamten Code in dieses Modul kopieren. (Option Strict ON, Option Explicit ON ist möglich.)

Die verschiedenen Bildbearbeitungs-Beispiele sind im Code auskommentiert.
Zum Testen sollte jeweils eines der Beispiele herangezogen werden.

Falls nicht das gesamte Bild zu bearbeiten ist, sondern die Bereiche der x,y-Schleife eingeschränkt werden, ist die angegebene Formel zur Berechnung des Wertes der Variable 'Byte_Index’ zu verwenden.

''' <summary>
''' Demo-Routine: schnelle, pixelbezogene Bildbearbeitung
''' </summary>
''' <param name="Bilddatei_in">Bilddatei (wird geladen)</param>
''' <param name="Bilddatei_out">Ausgabedatei 
''' (wird ggf. überschrieben!)</param>
Public Sub Pixel_Manipulation( _
  ByVal Bilddatei_in As String, _
  ByVal Bilddatei_out As String)
 
  ' Die Funktion demonstriert die direkte Bearbeitung 
  ' der Pixeldaten einer Bilddatei und
  ' schreibt das Ergebnis in die Datei 'Bilddatei_out'
 
  Dim x, y As Integer ' Loop
  Dim Byte_Index As Integer = -3 ' Index im 1D-Array
 
  ' Bitmap aus Datei laden
  Dim bmp_in As New Drawing.Bitmap(Bilddatei_in)
 
  ' Rectangle für die Größe des gesamten 
  ' geladenen Bildes erstellen 
  Dim bmp_rect As New Drawing.Rectangle(0, 0, bmp_in.Width, bmp_in.Height)
 
  ' Eine Arbeits-Bitmap (24-Bit pro Pixel) 
  ' in der erforderlichen Größe erstellen 
  Dim bmp As New System.Drawing.Bitmap(bmp_in.Width, bmp_in.Height, _
    Drawing.Imaging.PixelFormat.Format24bppRgb)
 
  ' Liegt bereits eine 24-Bit-Bitmap vor?
  If bmp_in.PixelFormat <> Drawing.Imaging.PixelFormat.Format24bppRgb Then
    ' Ein Zeichnenobjekt für 'bmp' erstellen
    Dim mg As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
 
    ' Die geladene Bitmap in 'bmp' neu zeichnen 
    mg.DrawImage(bmp_in, bmp_rect)
 
    ' Zeichnen-Ressourcen freigeben
    mg.Dispose()
  Else
    ' Verweis auf geladene Bitmap setzen
    bmp = bmp_in.Clone(bmp_rect, bmp_in.PixelFormat)
  End If
 
  ' Bilddaten (ggf. Ausschnitt) im Speicher sperren
  Dim bmp_data As Drawing.Imaging.BitmapData = _
    bmp.LockBits(bmp_rect, Drawing.Imaging.ImageLockMode.ReadWrite, _
    bmp.PixelFormat)
 
  ' Adresse des Beginns der Bitmap-Bilddaten ermitteln
  Dim bmp_ptr As IntPtr = bmp_data.Scan0
 
  ' Array für Bitmapdaten in geeigneter Größe erstellen
  ' (24-Bit-Bitmap: 3 Byte / Pixel in Bildbreite)
  Dim bmp_bytes As Integer = bmp.Width * bmp.Height * 3
 
  ' Null-basiertes Byte-Array (muss eindimensional sein)
  ' in der erforderlichen Größe vereinbaren
  Dim bmp_array(0 To bmp_bytes - 1) As Byte
 
  ' Die Bitmapdaten in das Array kopieren
  Runtime.InteropServices.Marshal.Copy(bmp_ptr, bmp_array, 0, bmp_bytes)
 
  ' Bearbeitungsvektor für Pixel-Bytes erstellen
  ' =============================================
  Dim bearb_vek() As Byte
  ReDim bearb_vek(0 To Byte.MaxValue)
  ' Vektor initialisieren (=kein Effekt)
  For x = 0 To Byte.MaxValue
    bearb_vek(x) = CByte(x)
  Next x
 
  ' Bearbeitungsvektor für den Effekt einrichtn
  ' ============================================
  Call Helligkeit_Ändern(40, bearb_vek) ' Helligkeit ändern
  ' Call Kontrast_Ändern(50, bearb_vek) ' Kontrast ändern
  ' Call Aufhellen(50, bearb_vek) ' nur dunkle Pixel aufhellen
  ' Call Farben_Invertieren(bearb_vek) ' Farben Invertieren 
 
  ' Die Bilddaten bearbeiten
  ' (Doppelschleife mit y-x-pixelbezogenem Zugriff 
  ' auf die Daten im Array)
  For y = 1 To bmp.Height
    For x = 1 To bmp.Width
 
      ' Array-Index, 
      ' falls das gesamte Bild bearbeitet wird
      Byte_Index += 3
 
      ' Formel zur Umrechnung von x,y 
      ' auf den entsprechenden Array-Index 
      ' (falls nur Bildausschnitte bearbeitet werden
      ' z.b. Schleife: y = 50 to 100 : x = 80 to 120)
 
      ' Byte_Index = (y - 1) * (bmp.Width * 3) + (x - 1) * 3
 
      ' Drei Byte/Pixel an Position x,y modifizieren
      ' Reihung allerdings je nach Hardware: 
      ' Rot - Grün - Blau oder Blau - Grün - Rot
 
      ' Anwendung des Bearbeitungsvektors 
      ' ===================================
      bmp_array(Byte_Index) = bearb_vek(bmp_array(Byte_Index))
      bmp_array(Byte_Index + 1) = bearb_vek(bmp_array(Byte_Index + 1))
      bmp_array(Byte_Index + 2) = bearb_vek(bmp_array(Byte_Index + 2))
 
      ' Weitere Beispiele (ohne Bearbeitungsvektor) 
      ' ==============================================
      ' Farbanteil_Entfernen( _
      '   bmp_array(Byte_Index), _
      '   bmp_array(Byte_Index + 1), _
      '   bmp_array(Byte_Index + 2))
 
      ' Farbwerte_Tauschen( _
      ' bmp_array(Byte_Index), _
      '   bmp_array(Byte_Index + 1), _
      '   bmp_array(Byte_Index + 2))
 
      ' Farbe_in_Grauton_Wandeln( _
      ' bmp_array(Byte_Index), _
      '   bmp_array(Byte_Index + 1), _
      '   bmp_array(Byte_Index + 2))
 
      ' schwarzes Gitter ins Bild eintragen 
      ' If x Mod 50 = 0 Or y Mod 50 = 0 Then
      '   bmp_array(Byte_Index) = 0
      '   bmp_array(Byte_Index + 1) = 0
      '   bmp_array(Byte_Index + 2) = 0
      ' End If
    Next x
  Next y
 
  ' Die modifizierten Arraydaten 
  ' in die Bitmap zurück-kopieren 
  Runtime.InteropServices.Marshal.Copy(bmp_array, 0, bmp_ptr, bmp_bytes)
 
  ' Die gesperrten Bilddaten (ggf. Ausschnitt) 
  ' im Speicher wieder freigeben
  bmp.UnlockBits(bmp_data)
 
  ' Das modifizierte Bild in einem Format speichern,
  ' das der angegebenen Filename-Extension entspricht
  bmp.Save(Bilddatei_out, Bildformat(Bilddatei_out))
 
  ' ergänzendes Beispiel für das Speichern eines
  ' JPG-Bildes mit vorgegebener Qualitätsstufe
  ' sinnvolle Qualitäten liegen im Bereich 50 <-> 95
  Dim lQuality As Integer = 50
 
  Dim EncoderParameters As _
    New Drawing.Imaging.EncoderParameters(1)
 
  EncoderParameters.Param(0) = New _
    Drawing.Imaging.EncoderParameter( _
    Drawing.Imaging.Encoder.Quality, _
    CType(lQuality, Int32))
 
  ' Speicherbefehl:
  ' bmp.Save(Bilddatei_out, _
  '   EncoderInfo("JPEG"), _
  '   EncoderParameters)
 
  ' ergänzendes Beispiel für das Speichern eines
  ' TIFF-Bildes ohne Komprimierung
  ' Hinweis: Einige der für TIFF vorgesehenen
  ' Komprimierungsformen (in EncoderValue) haben 
  ' bei mir zu Laufzeit-Fehlern geführt!! 
  EncoderParameters.Param(0) = New _
    Drawing.Imaging.EncoderParameter( _
    Drawing.Imaging.Encoder.Compression, _
    Fix(Drawing.Imaging.EncoderValue.CompressionNone))
 
  ' Speicherbefehl:
  ' bmp.Save(Bilddatei_out, _
  '   EncoderInfo("TIFF"), _
  '   EncoderParameters)
 
  ' Bitmap-Ressourcen ggf. freigeben
  bmp.Dispose() : bmp_in.Dispose()
End Sub

' =====================================================================
' Routinen zur Bestimmung des jeweils erforderlichen 
' Byte-Bearbeitungsvektors für einen bestimmten Effekt
' =====================================================================

''' <summary>
''' Vektor für Anhebung/Senkung der Farbintensität 
''' (Bildhelligkeit)
''' </summary>
''' <param name="Intensitätsdifferenz"></param>
''' <param name="vek">Bearbeitungsvektor</param>
Private Sub Helligkeit_Ändern( _
  ByVal Intensitätsdifferenz As Integer, _
  ByRef vek() As Byte)
 
  ' Die Schleifenvariable darf nicht Byte sein, weil
  ' sie nach Schleifendurchlauf auf 256 gesetzt ist !!!!
  Dim i As Integer
 
  ' Bearbeitungsvektor
  ReDim vek(0 To Byte.MaxValue)
 
  For i = 0 To vek.GetUpperBound(0)
    vek(i) = FarbByte_Addition( _
      CByte(i), Intensitätsdifferenz)
  Next i
End Sub

''' <summary>
''' Vektor für Invertieren der Farben
''' </summary>
''' <param name="vek">Bearbeitungsvektor</param>
Private Sub Farben_Invertieren(ByRef vek() As Byte)
  Dim i As Integer
  ReDim vek(0 To Byte.MaxValue)
 
  For i = 0 To vek.GetUpperBound(0)
    vek(i) = CByte(Byte.MaxValue - i)
  Next i
End Sub

''' <summary>
''' Vektor für Kontraständerung
''' </summary>
''' <param name="Kontrastfaktor">Richtung und Stärke</param>
''' <param name="vek">Bearbeitungsvektor</param>
Private Sub Kontrast_Ändern(ByVal Kontrastfaktor As Integer, _
  ByRef vek() As Byte)
 
  ' positiver Kontrastfaktor erhöht den Kontrast
  ' negativer Faktor senkt den Kontrast
  Dim i As Integer
  Dim diff As Double
 
  Dim cGrenzIntensität As Integer = 128
 
  ReDim vek(0 To Byte.MaxValue)
  For i = 0 To vek.GetUpperBound(0)
    If i < cGrenzIntensität Then
      diff = CDbl(cGrenzIntensität - i) / _
        cGrenzIntensität * Kontrastfaktor
    Else
      diff = -CDbl(i - cGrenzIntensität) / _
        cGrenzIntensität * -Kontrastfaktor
    End If
    vek(i) = FarbByte_Addition( _
    CByte(i), CInt(diff))
  Next i
End Sub

''' <summary>
''' Vektor für selektive Bildaufhellung
''' (Intensitätserhöhung bei relativ dunklen Pixeln) 
''' </summary>
''' <param name="Aufhellfaktor">Stärke der Aufhellung</param>
''' <param name="vek">Bearbeitungsvektor</param>
Private Sub Aufhellen( _
  ByVal Aufhellfaktor As Integer, _
  ByRef vek() As Byte)
 
  Dim i As Integer
  Dim diff As Double
 
  Dim cGrenzIntensität As Integer = 160
 
  ReDim vek(0 To Byte.MaxValue)
 
  For i = 0 To vek.GetUpperBound(0)
    diff = 0
    ' Intensitäten ab der
    ' Grenzintensität bleiben unverändert 
    If i < cGrenzIntensität Then
      diff = CDbl(cGrenzIntensität - i) / _
        cGrenzIntensität * Aufhellfaktor
    End If
    vek(i) = FarbByte_Addition( _
    CByte(i), CInt(diff))
  Next i
End Sub

' ===============================================================
' Routinen zur direkten Bearbeitung einzelner Pixel-Bytes
' ===============================================================

''' <summary>
''' Pixelmanipulation: Entfernen eines Farbanteils
''' </summary>
''' <param name="f1">1. Byte des 24-Bit-Pixel</param>
''' <param name="f2">2. Byte des 24-Bit_Pixel</param>
''' <param name="f3">3. Byte des 24-Bit-Pixel</param>
Private Sub Farbanteil_Entfernen( _
  ByRef f1 As Byte, ByRef f2 As Byte, ByRef f3 As Byte)
 
  ' Die Intensität von f2 wird auf 0 gesetzt
 
  f2 = 0
End Sub

''' <summary>
''' Pixelmanipulation: Austausch von Farbwerten
''' </summary>
''' <param name="f1">1. Farb-Byte</param>
''' <param name="f2">2. Farb-Byte</param>
''' <param name="f3">3. Farb-Byte</param>
Private Sub Farbwerte_Tauschen( _
  ByRef f1 As Byte, ByRef f2 As Byte, ByRef f3 As Byte)
 
  ' Die Intensität des ersten und dritten 
  ' Farb-Bytes wird ausgewechselt
 
  Swap_Bytes(f1, f3)
End Sub

''' <summary>
''' Pixelmanipulation: Farbe in Grauton
''' </summary>
''' <param name="f1">1. Farb-Byte</param>
''' <param name="f2">2. Farb-Byte</param>
''' <param name="f3">3. Farb-Byte</param>
Private Sub Farbe_in_Grauton_Wandeln( _
  ByRef f1 As Byte, ByRef f2 As Byte, ByRef f3 As Byte)
 
  ' Mittlere Intensität der Farbbytes berechnen
  Dim fm As Double = (CDbl(f1) + f2 + f3) / 3
 
  ' Alle Farbbytes erhalten die mittlere Intensität
  ' ==> Grauton
  f1 = CByte(fm)
  f2 = CByte(fm)
  f3 = CByte(fm)
End Sub

' ===============================================================
' Hilfsfunktionen
' ===============================================================

''' <summary>
''' Hilfsfunktion: Addition eines Wertes zu einem Byte
''' </summary>
''' <param name="FarbByte">Zu addierendes Byte</param>
''' <param name="Add">Zu addierender Wert</param>
''' <returns>Modifiziertes Byte</returns>
Private Function FarbByte_Addition( _
  ByVal FarbByte As Byte, _
  ByVal Add As Integer) As Byte
 
  Dim erg As Integer = CInt(FarbByte)
  erg += Add
  If erg > 255 Then erg = 255
  If erg < 0 Then erg = 0
  Return CByte(erg)
End Function

''' <summary>
''' Hilfsfunktion: Austausch von 2 Bytes
''' </summary>
''' <param name="a">1. Byte</param>
''' <param name="b">2. Byte</param>
Private Sub Swap_Bytes(ByRef a As Byte, ByRef b As Byte)
  Dim c As Byte = a
  a = b : b = c
End Sub

''' <summary>
''' Zum 'Extension' im Namen einer Bilddatei wird
''' das entsprechende Bildformat ermittelt
''' </summary>
''' <param name="File">Filename</param>
''' <returns>Bildformat</returns>
Private Function Bildformat(ByVal File As String) As _
  Drawing.Imaging.ImageFormat
 
  File = Trim(UCase(File))
  If Len(File) < 5 Then
    Return Drawing.Imaging.ImageFormat.Bmp
  End If
 
  Dim ext3 As String = Right(File, 4)
  Dim ext4 As String = Right(File, 5)
 
  If ext3 = ".JPG" Or ext3 = ".JPE" Or _
    ext4 = ".JPEG" Or ext4 = ".JFIF" Then
    Return Drawing.Imaging.ImageFormat.Jpeg
  ElseIf ext3 = ".TIF" Or ext4 = ".TIFF" Then
    Return Drawing.Imaging.ImageFormat.Tiff
  ElseIf ext3 = ".PNG" Then
    Return Drawing.Imaging.ImageFormat.Png
  ElseIf ext3 = ".GIF" Then
    Return Drawing.Imaging.ImageFormat.Gif
  Else
    ' sonst: (BMP, DIB, RLE)
    Return Drawing.Imaging.ImageFormat.Bmp
  End If
End Function

''' <summary>
''' Hilfsfunktion ermittelt den GDI+-Encoder
''' zu einem Bildformat-Descriptor
''' </summary>
''' <param name="FormatDescriptor">Bildformat</param>
''' <returns>zugehörige Codec-Information</returns>
Private Function EncoderInfo( _
  ByVal FormatDescriptor As String) As _
  Drawing.Imaging.ImageCodecInfo
 
  ' Formatdescriptoren: BMP JPEG GIF TIFF PNG
 
  Dim i As Integer = 0
  Dim encoders() As Drawing.Imaging.ImageCodecInfo = _
    Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
 
  FormatDescriptor = Trim(UCase(FormatDescriptor))
 
  While i < encoders.Length
    If UCase(encoders(i).FormatDescription) = FormatDescriptor Then
      Return encoders(i)
    End If
    i += 1
  End While
  Return Nothing
End Function