vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: .NET   |   VB-Versionen: VB 200515.12.07
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 BohnBewertung:     [ Jetzt bewerten ]Views:  14.687 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise bis zu 120,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 479,20 EUR statt 599,- EUR
  • sevDTA 3.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 20,00 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 55,20 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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

    Dieser Workshop wurde bereits 14.687 mal aufgerufen.

    Über diesen Workshop im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Workshop, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Aktuelle Diskussion anzeigen (4 Beiträge)

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

    Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
    - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
    - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
    Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
     
       

    Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
    Alle 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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel