VB.NET-Tipp 0067: Einfaches optisches Schärfen eines Bildes

 
' 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

    ''' <summary>
    ''' optisches schärfen einer Bitmap
    ''' </summary>
    ''' <param name="InBitmap">Bitmap-Objekt</param>
    ''' <param name="Value">Value (0 bis 100, 0 = Normal)</param>
    ''' <returns>Bitmap-Objekt</returns>
    Private Function Sharpen(ByVal InBitmap As Bitmap, _
        ByVal Value As Double) As Bitmap

        ' Filterbereich festlegen
        If Value < 0 Then Value = 0
        If Value > 100 Then Value = 100
        Value = Value / 50

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

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

        ' Für die Aufnahme der Farbwerte
        Dim SharpenRed As New Double
        Dim SharpenGreen As New Double
        Dim SharpenBlue As New Double

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

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

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

        ' InBitmap in ein 24bppRGB Bitmap konvertieren -> Bmp24
        ' gleichzeitig stehen uns im gepinntem ByteArray InData 
        ' die Bitmapdaten von Bmp24 zur Verfügung
        Dim Bmp24 As New Bitmap(InBitmap.Width, InBitmap.Height, _
            Bmp24Stride, PixelFormat.Format24bppRgb, _
            hInData.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

                ' Pixelposition im ByteArray berechnen
                Bmp24Pos = (intY * Bmp24Stride) + (intX * 3)

                ' aktuelle Faben aus dem ByteArray InData auslesen
                SharpenRed = InData(Bmp24Pos + 2)
                SharpenGreen = InData(Bmp24Pos + 1)
                SharpenBlue = InData(Bmp24Pos + 0)

                If (intY - 1) >= 0 Then
                    If (intX - 1) >= 0 Then

                        ' Pixelposition im ByteArray berechnen
                        Bmp24Pos1 = ((intY - 1) * Bmp24Stride) + _
                            ((intX - 1) * 3)

                        SharpenRed = Math.Abs(SharpenRed + (Value * _
                            (SharpenRed - InData(Bmp24Pos1 + 2))))

                        SharpenGreen = Math.Abs(SharpenGreen + (Value * _
                            (SharpenGreen - InData(Bmp24Pos1 + 1))))

                        SharpenBlue = Math.Abs(SharpenBlue + (Value * _
                            (SharpenBlue - InData(Bmp24Pos1 + 0))))

                        If SharpenRed > 255 Then SharpenRed = 255
                        If SharpenGreen > 255 Then SharpenGreen = 255
                        If SharpenBlue > 255 Then SharpenBlue = 255

                    End If
                End If

                ' berechnete Farben in das ByteArray OutData schreiben
                OutData(Bmp24Pos + 2) = CByte(SharpenRed)
                OutData(Bmp24Pos + 1) = CByte(SharpenGreen)
                OutData(Bmp24Pos + 0) = CByte(SharpenBlue)

            Next
        Next

        ' Handle auf das gepinnte ByteArray InData freigeben
        hInData.Free()

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

        ' neues BitmapData-Objekt erstellen
        Dim NewBmp24BD As New BitmapData
        NewBmp24BD.Width = Bmp24.Width
        NewBmp24BD.Height = Bmp24.Height
        NewBmp24BD.Stride = Bmp24Stride
        NewBmp24BD.PixelFormat = Bmp24.PixelFormat
        NewBmp24BD.Scan0 = hOutData.AddrOfPinnedObject()

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

        ' Sperrung der Bitmapdaten aufheben
        Bmp24.UnlockBits(Bmp24BD)

        ' Handle auf das gepinnte ByteArray OutData freigeben
        hOutData.Free()

        Return Bmp24
    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
        PictureBox2.Image = My.Resources.City005
    End Sub

    Private Sub HScrollBar1_Scroll( _
        ByVal sender As System.Object, _
        ByVal e As System.Windows.Forms.ScrollEventArgs) _
        Handles HScrollBar1.Scroll

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

        PictureBox2.Image = Sharpen( _
            CType(PictureBox1.Image, Bitmap), HScrollBar1.Value)
    End Sub
End Class