Problemstellung: 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:
Abgesehen vom Namespace 'System', sind im Demo-Code die Objekte, Eigenschaften und Methoden 'voll qualifiziert', damit man sich besser zurechtfinden kann.
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. 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 20.651 mal aufgerufen.
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
|||||||||||||
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. |