Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0066: Bitmapobjekt in das 1bppIndexed-Bitmapformat konvertieren (Ordered Dither)

 von 

Beschreibung

Beim Umwandeln eines Bildes in ein Schwarz/Weiß-Bild entstehen normalerweise verschieden große schwarze oder weiße Flächen.
Das Ordered Dither-Verfahren hingegen erzeugt differenzierte Grauabstufungen, indem die schwarzen Bildpunkte unterschiedlich dicht gesetzt werden.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Framework-Version(en):

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

.NET-Version(en):

Visual Basic 2005, Visual Basic 2008

Download:

Download des Beispielprojektes [42,76 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.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Option Strict On
Option Explicit On

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class Form1

    ' hält die Daten für die FarbMatrix
    Private VecColor As Integer() = New Integer(765) {}

    ' DitherMatrix
    Private VecDither As Byte(,) = New Byte(,) { _
            {1, 9, 4, 12}, _
            {13, 5, 16, 8}, _
            {3, 11, 2, 10}, _
            {15, 7, 14, 6}}

    Private Function BlackWhiteOrderedDither(ByVal InBitmap As Bitmap, _
        ByVal WhiteColor As Color, ByVal BlackColor As Color) As Bitmap

        ' Für die For/Next Schleifen
        Dim intX As New Integer
        Dim intY As New Integer

        ' Für die Pixelpositionen im ByteArray
        Dim Bmp1Pos As New Integer
        Dim Bmp24Pos As New Integer

        ' Breite einer Bildzeile inkl. PadBytes berechnen
        Dim Bmp1Stride As Integer = ((InBitmap.Width + 31) And Not 31) \ 8
        Dim Bmp24Stride As Integer = ((InBitmap.Width * 3) + 3) And Not 3

        ' ByteArrays zur Aufnahme der gesamten Bitmapdaten dimensionieren
        Dim Bmp1Data As Byte() = _
            New Byte((InBitmap.Height * Bmp1Stride) - 1) {}
        Dim Bmp24Data As Byte() = _
            New Byte((InBitmap.Height * Bmp24Stride) - 1) {}

        ' Handle auf das gepinnte ByteArray Bmp24Data holen
        Dim hBmp24Data As GCHandle = _
            GCHandle.Alloc(Bmp24Data, GCHandleType.Pinned)

        ' InBitmap in ein 24bppRGB Bitmap konvertieren -> Bmp24
        ' gleichzeitig stehen uns im gepinntem ByteArray Bmp24Data 
        ' die Bitmapdaten von Bmp24 zur Verfügung
        Using Bmp24 As New Bitmap(InBitmap.Width, InBitmap.Height, _
            Bmp24Stride, PixelFormat.Format24bppRgb, _
            hBmp24Data.AddrOfPinnedObject())

            ' Graphicsobjekt von Bmp24 erstellen -> Bmp24Gra
            Using Bmp24Gra As Graphics = Graphics.FromImage(Bmp24)

                ' InBitmap in das Graphicsobjekt zeichnen
                Bmp24Gra.DrawImageUnscaledAndClipped(InBitmap, _
                    New Rectangle(0, 0, Bmp24.Width, Bmp24.Height))

                ' Bmp24Gra löschen (dispose)
            End Using

            ' alle Pixel durchlaufen
            For intY = 0 To Bmp24.Height - 1
                For intX = 0 To Bmp24.Width - 1

                    ' Pixelpositionen in den ByteArrays berechnen
                    Bmp24Pos = (intY * Bmp24Stride) + (intX * 3)
                    Bmp1Pos = (intY * Bmp1Stride) + (intX \ 8)

                    ' Ist der Wert in der FarbMatrix > dem Wert in der 
                    '  DitherMatrix
                    If VecColor(CInt(Bmp24Data(Bmp24Pos + 2)) + _
                        Bmp24Data(Bmp24Pos + 1) + Bmp24Data(Bmp24Pos + 0)) > _
                        VecDither(intX Mod 4, intY Mod 4) Then

                        ' Index für den Pixel berechnen
                        ' der berechnete Index verweist auf eine Farbe in der
                        ' Farbpalette -> Bmp1Pal
                        Bmp1Data(Bmp1Pos) = Bmp1Data(Bmp1Pos) Or _
                            CByte(&H80 >> (intX And &H7))

                    End If

                Next
            Next

            ' Bmp24 löschen (dispose)
        End Using

        ' Handle auf das gepinnte ByteArray Bmp24Data freigeben
        hBmp24Data.Free()

        ' Handle auf das gepinnte ByteArray Bmp1Data holen
        Dim hBmp1Data As GCHandle = _
            GCHandle.Alloc(Bmp1Data, GCHandleType.Pinned)

        ' neues BitmapData-Objekt erstellen
        Dim NewBmp1BD As New BitmapData
        NewBmp1BD.Width = InBitmap.Width
        NewBmp1BD.Height = InBitmap.Height
        NewBmp1BD.Stride = Bmp1Stride
        NewBmp1BD.PixelFormat = PixelFormat.Format1bppIndexed
        ' Zeiger auf das gepinnte ByteArray
        NewBmp1BD.Scan0 = hBmp1Data.AddrOfPinnedObject()

        ' neues 1bppIndexed Bitmap erstellen -> Bmp1
        Dim Bmp1 As New Bitmap(InBitmap.Width, InBitmap.Height, _
            PixelFormat.Format1bppIndexed)

        'Bitmapdaten von Bmp1 sperren und die Daten von NewBmp1BD übertragen
        Dim Bmp1BD As BitmapData = _
            Bmp1.LockBits(New Rectangle(0, 0, Bmp1.Width, Bmp1.Height), _
            ImageLockMode.WriteOnly Or ImageLockMode.UserInputBuffer, _
            Bmp1.PixelFormat, NewBmp1BD)

        ' Sperrung der Bitmapdaten aufheben
        Bmp1.UnlockBits(Bmp1BD)

        ' Handle auf das gepinnte ByteArray Bmp1Data freigeben
        hBmp1Data.Free()

        ' aktuelle Farbpalette von Bmp1 auslesen
        ' diese enthält zu diesem Zeitpunkt bereits
        ' eine Standard-Farbpalette die wir durch eine
        ' neue Farbpalette ersetzen können
        Dim Bmp1Pal As ColorPalette = Bmp1.Palette

        ' Farbwerte in die Palette schreiben
        Bmp1Pal.Entries(0) = BlackColor
        Bmp1Pal.Entries(1) = WhiteColor

        ' Standard-Farbpalette durch die neue Farbpalette ersetzen
        Bmp1.Palette = Bmp1Pal

        Return Bmp1
    End Function

    Private Sub Form1_Load(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles Me.Load

        ' Bild aus der Ressource laden und anzeigen
        PictureBox1.Image = My.Resources.RoteAugen

        ' FarbMatrix
        For X As Integer = 0 To 765
            VecColor(X) = 1 + (X \ 3) \ 16
        Next
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles Button1.Click

        ' ist ein Bild in der PictureBox vorhanden
        If Not PictureBox2.Image Is Nothing Then
            ' Bild löschen  
            PictureBox2.Image.Dispose()
        End If

        PictureBox2.Image = BlackWhiteOrderedDither( _
            CType(PictureBox1.Image, Bitmap), Color.White, Color.Black)
    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.