vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

VB.NET - Fortgeschrittene
Re: Umriss um unregelmäßige Formen zeichnen 
Autor: Manfred X
Datum: 04.11.11 05:17

Hallo!

Photos, die in Grausstufen gewandelt werden, umfassen 256 Graustufen.
Eine bestimmte Fläche besteht dabei gewöhnlich nicht aus EINER
Graustufe, sondern sie variiert auch innerhalb einer Fläche.
Flächenbegrenzungen können deshalb nur über einen Schwellenwert
für die Grau-Differenz ermittelt werden, wobei der krit. Differenzwert umso
größer gewählt werden muss je stärker die Farbvarianz in der Fläche ist.
Hier eine triviale Funktion.
Public Shared Function GrauÜbergänge_Markieren _
      (ByVal bmp_in As Bitmap,
      ByVal ThresholdValue As Integer) As Bitmap
 
   If bmp_in Is Nothing Then Return Nothing
 
   '24 Bit-Bitmap erstellen
   Dim gray As New Bitmap(bmp_in.Width, bmp_in.Height, _
   Imaging.PixelFormat.Format24bppRgb)
   Dim g As Graphics = Graphics.FromImage(gray)
   g.DrawImage(bmp_in, 0, 0)
   g.Dispose()
   'MakeImageGrayscale(gray) optional, Funktion aus dem Net-Forum
   Dim gray_rect As New Rectangle(0, 0, gray.Width, gray.Height)
 
   ' Bilddaten im Speicher sperren
   Dim gray_data As Drawing.Imaging.BitmapData = _
   gray.LockBits(gray_rect, Drawing.Imaging.ImageLockMode.ReadWrite, _
   gray.PixelFormat)
 
   ' Array für Bitmapdaten in geeigneter Größe erstellen
   Dim gray_bytes As Integer = gray_data.Stride * gray.Height
   Dim gray_array(0 To gray_bytes - 1) As Byte
   Dim marker_array(0 To gray_bytes - 1) As Byte
   For i As Integer = 0 To marker_array.Length - 1 
       marker_array(i) = 255 
   Next i
 
   ' Die Bitmapdaten in das Array kopieren
   Runtime.InteropServices.Marshal.Copy _
   (gray_data.Scan0, gray_array, 0, gray_bytes)
 
   Dim ystart As Integer = 0, yende As Integer = gray.Height - 1
   Dim xstart As Integer = 0, xende As Integer = gray.Width - 1
   Dim stride As Integer = gray_data.Stride
   Dim centervalue As Byte
   'DoppelSchleife (Indices = Pixelbezogen)
   For y As Integer = ystart + 1 To yende - 1
      For x As Integer = xstart + 1 To xende - 1
         'Umrechnung auf eindimensionales Byte-Array 
         '(3 Bytes/Pixel in x-Richtung)
         centervalue = gray_array(y * stride + x * 3)
         'Schleife über Nachbarpixel
         For y1 As Integer = y - 1 To y + 1
             For x1 As Integer = x - 1 To x + 1
                 If Math.Abs(CInt(gray_array(y1 * stride + x1 * 3)) _
                   - centervalue) > ThresholdValue Then
                   marker_array(y * stride + x * 3) = centervalue
                   marker_array(y * stride + x * 3 + 1) = centervalue
                   marker_array(y * stride + x * 3 + 2) = centervalue
                   Exit For
                 End If
             Next x1
         Next y1
      Next x
   Next y
 
   ' Das Markerarray zurück-kopieren 
   Runtime.InteropServices.Marshal.Copy _
   (marker_array, 0, gray_data.Scan0, gray_bytes)
   With gray
       .UnlockBits(gray_data)
   End With
   Return gray
End Function
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Umriss um unregelmäßige Formen zeichnen6.010Preußen_Paul04.11.11 00:55
Re: Umriss um unregelmäßige Formen zeichnen2.947Manfred X04.11.11 05:17
Re: Umriss um unregelmäßige Formen zeichnen3.027Preußen_Paul05.11.11 01:10
Re: Umriss um unregelmäßige Formen zeichnen2.691Manfred X05.11.11 06:18
Re: Umriss um unregelmäßige Formen zeichnen2.672Zardoz06.11.11 19:29
Re: Umriss um unregelmäßige Formen zeichnen2.729bauer14.11.11 10:49

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel