VB.NET-Tipp 0067: Einfaches optisches Schärfen eines Bildes
von Frank Schüler
Beschreibung
Dieses Beispiel zeigt wie eine einfache optische Schärfung eines Bildes vorgenommen werden kann.
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: |
' 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
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.