Die Community zu .NET und Classic VB.

Startseite / Tipps / VB.NET-Tipp 0068: Schwarz/Weiß-Bild durch das Error Diffusion-Verfahren erstellen

VB.NET-Tipp 0068: Schwarz/Weiß-Bild durch das Error Diffusion-Verfahren erstellen

 von Frank Schüler

Schwierigkeitsgrad:

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 [49,61 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) {}

    ' 3x3 Matrix
    ' |-1|-1|-1|
    ' |-1|10|-1|
    ' |-1|-1|-1| / 2 + 0

    ' ---=== Filter Matrix ===---
    Private mDivisor As Integer = 2
    Private mOffset As Integer = 0

    Private mMatrix As Integer(,) = New Integer(,) _
        {{-1, -1, -1}, _
        {-1, 10, -1}, _
        {-1, -1, -1}}

    ' halbe Dimensionen der Matrix speichern
    Private MatrixX As Integer = (mMatrix.GetLength(0) - 1) \ 2
    Private MatrixY As Integer = (mMatrix.GetLength(1) - 1) \ 2

    ' für die Position in der Martix inerhalb der Schleife
    Private MatrixXX As New Integer
    Private MatrixYY As New Integer

    ' Für die For/Next Schleifen
    Private intX As New Integer
    Private intY As New Integer
    Private intX1 As New Integer
    Private intY1 As New Integer

    ' Für die Pixelposition im ByteArray
    Private PixelX As New Integer
    Private PixelY As New Integer
    Private OrgPixelPos As New Integer
    Private NewPixelPos As New Integer

    ' zur Aufnahme der berechneten Farbwerte
    Private Red As New Integer
    Private Green As New Integer
    Private Blue As New Integer
    Private ColOrgDiff As New Integer
    Private ColMatDiff As New Integer
    Private ColPixel As New Integer
    Private ErrDiff As New Integer

    Private Function BlackWhiteErrorDiffusion( _
        ByVal InBitmap As Bitmap) As Bitmap

        ' Höhe und Breite von InBitmap speichern
        Dim PicWidth As Integer = InBitmap.Width
        Dim PicHeight As Integer = InBitmap.Height
        Dim PicRect As New Rectangle(0, 0, PicWidth, PicHeight)

        ' Breite einer Bildzeile inkl. PadBytes berechnen (24bppRGB)
        Dim PicStride As Integer = ((PicWidth * 3) + 3) And Not 3

        ' ByteArrays zur Aufnahme der gesamten Bitmapdaten dimensionieren
        Dim OrgData As Byte() = New Byte((PicHeight * PicStride) - 1) {}
        Dim NewData As Byte() = New Byte((PicHeight * PicStride) - 1) {}

        ' Handle auf das gepinnte ByteArray OrgData holen
        Dim hOrgData As GCHandle = GCHandle.Alloc(OrgData, GCHandleType.Pinned)

        ' InBitmap in ein 24bppRGB Bitmap konvertieren -> NewBitmap
        ' gleichzeitig stehen uns im gepinntem ByteArray OrgData 
        ' die Bitmapdaten von NewBitmap zur Verfügung
        Dim NewBitmap As New Bitmap(PicWidth, PicHeight, PicStride, _
            PixelFormat.Format24bppRgb, hOrgData.AddrOfPinnedObject())

        ' Graphicsobjekt von NewBitmap erstellen
        Using GR As Graphics = Graphics.FromImage(NewBitmap)

            ' InBitmap in das Graphicsobjekt zeichnen
            GR.DrawImageUnscaledAndClipped(InBitmap, PicRect)

            ' GR löschen (dispose)
        End Using

        ' alle Pixel durchlaufen
        For intY = 0 To PicHeight - 1
            For intX = 0 To PicWidth - 1

                ' Pixelposition im ByteArray berechnen
                OrgPixelPos = (intY * PicStride) + (intX * 3) '(24bppRGB)

                Red = OrgData(OrgPixelPos + 2)
                Green = OrgData(OrgPixelPos + 1)
                Blue = OrgData(OrgPixelPos + 0)

                ' Wert aus FarbMatrix aufaddieren
                ColOrgDiff = ColOrgDiff + VecColor(Red + Green + Blue)

            Next
        Next

        ' aufaddierten Wert durch Anzahl der Pixel teilen
        ColOrgDiff = ColOrgDiff \ (PicWidth * PicHeight)

        ' alle Pixel durchlaufen
        For intY = 0 To PicHeight - 1
            For intX = 0 To PicWidth - 1

                'Farbwerte zurücksetzen
                Red = 0
                Green = 0
                Blue = 0

                ' X-Position in der Matrix zurücksetzen
                MatrixXX = 0

                ' PixelY -1 <- intY -> +1
                For intY1 = intY - MatrixY To intY + MatrixY

                    ' Y-Position in der Matrix zurücksetzen
                    MatrixYY = 0

                    ' PixelX -1 <- intX -> +1
                    For intX1 = intX - MatrixX To intX + MatrixX

                        ' Pixelposition speichern
                        PixelX = intX1
                        PixelY = intY1

                        ' Pixelpositionen außerhalb des Bildbereiches
                        ' in den Bildbereich verlagern
                        If PixelX < 0 Then PixelX = Math.Abs(PixelX)
                        If PixelY < 0 Then PixelY = Math.Abs(PixelY)

                        If PixelX > (PicWidth - 1) Then PixelX = _
                            (PicWidth - 1) - (PixelX - (PicWidth - 1))

                        If PixelY > (PicHeight - 1) Then PixelY = _
                            (PicHeight - 1) - (PixelY - (PicHeight - 1))

                        ' Pixelposition im ByteArray berechnen
                        ' (24bppRGB)
                        OrgPixelPos = (PixelY * PicStride) + (PixelX * 3)

                        ' Farbwerte berechnen
                        Red = Red + OrgData(OrgPixelPos + 2) * _
                            mMatrix(MatrixXX, MatrixYY)

                        Green = Green + OrgData(OrgPixelPos + 1) * _
                            mMatrix(MatrixXX, MatrixYY)

                        Blue = Blue + OrgData(OrgPixelPos + 0) * _
                            mMatrix(MatrixXX, MatrixYY)

                        ' Y-Position in der Matrix aufaddieren
                        MatrixYY = MatrixYY + 1
                    Next

                    ' Y-Position in der Matrix aufaddieren
                    MatrixXX = MatrixXX + 1

                Next

                ' Farbwerte weiter berechnen
                Red = (Red \ mDivisor) + mOffset
                Green = (Green \ mDivisor) + mOffset
                Blue = (Blue \ mDivisor) + mOffset

                ' Min/Max
                If Red < 0 Then Red = 0
                If Red > 255 Then Red = 255
                If Green < 0 Then Green = 0
                If Green > 255 Then Green = 255
                If Blue < 0 Then Blue = 0
                If Blue > 255 Then Blue = 255

                ' Wert aus FarbMatrix + Errordiffusionsfaktor
                ColMatDiff = VecColor(Red + Green + Blue) + ErrDiff

                ' Min/Max
                If ColMatDiff < 0 Then ColMatDiff = 0
                If ColMatDiff > 255 Then ColMatDiff = 255

                ' ist ColMatDiff < ColOrgDiff
                If ColMatDiff < ColOrgDiff Then
                    ColPixel = 0 ' Pixel schwarz
                Else
                    ColPixel = 255 ' Pixel weiß
                End If

                ' Errordiffusionsfaktor berechnen
                ErrDiff = (ColMatDiff - ColPixel) \ 4

                ' Pixelposition im ByteArray berechnen
                NewPixelPos = (intY * PicStride) + (intX * 3) '(24bppRGB)

                ' berechnete Farbwerte in das ByteArray schreiben
                NewData(NewPixelPos + 2) = CByte(ColPixel)
                NewData(NewPixelPos + 1) = CByte(ColPixel)
                NewData(NewPixelPos + 0) = CByte(ColPixel)

            Next
        Next

        ' Handle auf das gepinnte ByteArray OrgData freigeben
        hOrgData.Free()

        ' Handle auf das gepinnte ByteArray NewData holen
        Dim hNewData As GCHandle = GCHandle.Alloc(NewData, GCHandleType.Pinned)

        ' neues BitmapData-Objekt erstellen
        Dim NewBD As New BitmapData
        NewBD.Width = PicWidth
        NewBD.Height = PicHeight
        NewBD.Stride = PicStride
        NewBD.PixelFormat = NewBitmap.PixelFormat
        NewBD.Scan0 = hNewData.AddrOfPinnedObject()

        'Bitmapdaten von NewBitmap sperren und die Daten von NewBD übertragen
        Dim BD As BitmapData = NewBitmap.LockBits(PicRect, _
            ImageLockMode.WriteOnly Or ImageLockMode.UserInputBuffer, _
            NewBitmap.PixelFormat, NewBD)

        ' Sperrung der Bitmapdaten aufheben
        NewBitmap.UnlockBits(BD)

        ' Handle auf das gepinnte ByteArray NewData freigeben
        hNewData.Free()

        Return NewBitmap

    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.City005

        ' FarbMatrix
        For X As Integer = 0 To 765
            VecColor(X) = X \ 3
        Next

    End Sub

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

        ' falls vorhanden alte Bitmap löschen
        If Not PictureBox2.Image Is Nothing Then
            PictureBox2.Image.Dispose()
        End If

        PictureBox2.Image = _
            BlackWhiteErrorDiffusion(DirectCast(PictureBox1.Image, Bitmap))
    End Sub
End Class