Boundary Tracing

  • VB.NET
  • .NET (FX) 4.5–4.8

Es gibt 38 Antworten in diesem Thema. Der letzte Beitrag () ist von xd-franky-5.

    @xd-franky-5 Kannst Du mal ein signifikantes Bild anhängen?
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    @RodFromGermany, @~blaze~

    Aaaaaaaalso:
    Wir haben das Ausgangsbild (ein zufälliges Kennzeichen):


    Dieses wird skaliert, in Greyscale umgewandelt, dann lasse ich einen Gaussian Blurr drüber und per Canny-Algorithmus mit einem Otsu-Threshold werden die Kanten extrahiert.
    Das sieht dann so aus:


    Nun mein erster Anlauf den ich mir ausgedacht habe war im Uhrzeigersinn nach weiteren Punkten zu suchen, was aber nicht funktioniert hat.
    Im nachhinein habe ich festgestellt, dass mein Vorhaben quasi dieser Algo war: Moor Neighbor Tracing
    In dem Artikel steht auch, dass der Algorithmus seine schwächen hat.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Dim points As New List(Of Point)
    2. For x = 0 To bmp.Width - 1
    3. For y = 0 To bmp.Height - 1
    4. Dim col As Color = bmp.GetPixel(x, y)
    5. If col.ToArgb = Color.Black.ToArgb Then
    6. Dim whites As Integer = 0
    7. For a = -1 To 1
    8. For b = -1 To 1
    9. If bmp.Width > x + a AndAlso Not x + a < 0 AndAlso bmp.Height > y + b AndAlso Not y + b < 0 AndAlso Not Math.Abs(a) = Math.Abs(b) AndAlso bmp.GetPixel(x + a, y + b).ToArgb = Color.White.ToArgb Then whites += 1
    10. Next
    11. Next
    12. If whites > 0 Then points.Add(New Point(x, y))
    13. End If
    14. Next
    15. Next
    16. Dim edges As New List(Of Edge)
    17. For start = 0 To points.Count - 1
    18. If Not points(start) = Nothing Then
    19. Dim now As Integer = start
    20. Dim last As Integer = 0
    21. Dim edge As New Edge
    22. Do
    23. If now > 0 Then
    24. edge.Points.Add(points(now))
    25. now = points.IndexOf(GetClosestPoint(now, points))
    26. points(last) = Nothing
    27. If start = now Or now = 0 Then Exit Do
    28. last = now
    29. Else
    30. Exit Do
    31. End If
    32. Loop
    33. edge.MinimumLength = minlength
    34. If edge.Points.Count >= minlength Then edges.Add(edge)
    35. End If
    36. Next
    37. Public Shared Function GetClosestPoint(ByVal index As Integer, ByVal points As List(Of Point)) As Point
    38. Dim point As Point = points(index)
    39. For Each cp As Point In {New Point(0, -1), New Point(1, -1), New Point(1, 0), New Point(1, 1), New Point(0, 1), New Point(-1, 1), New Point(-1, 0), New Point(-1, -1)}.ToList
    40. Dim p As New Point(point.X + cp.X, point.Y + cp.Y)
    41. If points.Contains(p) Then Return p
    42. Next
    43. Return Nothing
    44. End Function




    Dann habe ich diese Anleitung gefunden: lmb.informatik.uni-freiburg.de…raktikum/BVAnl_muster.pdf
    Welcher dieser Algo ist: Square Tracing
    "In dem Artikel steht auch, dass der Algorithmus seine schwächen hat."
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Dim marked As New List(Of Point)
    2. For y = 0 To img.Height - 1
    3. For x = 0 To img.Width - 1
    4. Dim s As New Point(x, y)
    5. If Not lbmp.GetPixel(s.X, s.Y).ToArgb = Color.Black.ToArgb AndAlso Not marked.Contains(s) Then
    6. Dim n As Point = s
    7. Dim pol As New Polygon
    8. Dim dir As Integer = 0
    9. Do
    10. If n.X >= 0 AndAlso n.X < img.Width AndAlso n.Y >= 0 AndAlso n.Y < img.Height Then
    11. If Not lbmp.GetPixel(n.X, n.Y).ToArgb = Color.Black.ToArgb Then
    12. marked.Add(n)
    13. pol.Points.Add(n)
    14. dir += 1
    15. If dir > 7 Then dir -= 8
    16. Else
    17. dir -= 1
    18. If dir < 0 Then dir += 8
    19. End If
    20. n = SetDirection(n, dir)
    21. If s = n Then Exit Do
    22. Else
    23. Exit Do
    24. End If
    25. Loop
    26. pols.Add(pol)
    27. End If
    28. Next
    29. Next
    30. Private Shared Function SetDirection(ByVal point As Point, ByVal dir As Integer) As Point
    31. Select Case dir
    32. Case 0
    33. Return New Point(point.X + 1, point.Y)
    34. Case 1
    35. Return New Point(point.X + 1, point.Y - 1)
    36. Case 2
    37. Return New Point(point.X, point.Y - 1)
    38. Case 3
    39. Return New Point(point.X - 1, point.Y - 1)
    40. Case 4
    41. Return New Point(point.X - 1, point.Y)
    42. Case 5
    43. Return New Point(point.X - 1, point.Y - 1)
    44. Case 6
    45. Return New Point(point.X, point.Y + 1)
    46. Case 7
    47. Return New Point(point.X + 1, point.Y + 1)
    48. End Select
    49. End Function




    Und nun habe ich diesen versucht: users.utcluj.ro/~rdanescu/PI-L6e.pdf
    Der klappt aber irgendwie auch nicht.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Dim acw As List(Of Point) = {New Point(1, 0), New Point(1, -1), New Point(0, -1), New Point(-1, -1), New Point(-1, 0), New Point(-1, 1), New Point(0, 1), New Point(1, 1)}.ToList
    2. Dim pols As New List(Of Polygon)
    3. For y = 0 To img.Height - 1
    4. For x = 0 To img.Width - 1
    5. Dim P0 As New Point(x, y)
    6. Dim pol As New Polygon
    7. pol.Points.Add(P0)
    8. Dim dir As Integer = 7
    9. Do
    10. Dim sd As Integer
    11. If dir Mod 2 = 0 Then sd = (dir + 7) Mod 8 Else sd = (dir + 6) Mod 8
    12. Dim sdir As Integer = (sd + 9) Mod 8
    13. Do Until sd = sdir
    14. Dim p As New Point(x + acw(sd).X, y + acw(sd).Y)
    15. If p.X >= 0 AndAlso p.X < img.Width AndAlso p.Y >= 0 AndAlso p.Y < img.Height AndAlso lbmp.GetPixel(p.X, p.Y).ToArgb = Color.White.ToArgb Then
    16. pol.Points.Add(p)
    17. dir = sd
    18. Exit Do
    19. End If
    20. sd = (sd + 7) Mod 8
    21. Loop
    22. If pol.Points.Last = pol.Points(1) AndAlso pol.Points(pol.Points.Count - 2) = pol.Points.First Then Exit Do
    23. Loop
    24. pols.Add(pol)
    25. Next
    26. Next



    Ich weiß nicht, was ich immer falsch mache, aber die Algorithmen brechen immer nach ca. 30 Pixeln ab, manchmal auch nach einem, obwohl das eigentlich nicht möglich ist.
    Und ja ich arbeite mit Lockbits, das GetPixel ist 'ne eigene Funktion die nicht von der Klasse Bitmap sondern von meiner eigenen Klasse LBitmap ist und das Array anspricht :)

    Ich hoffe ihr könnt mir helfen :-S
    Viele Grüße Frank
    Auch ohne Kantenfindung sollte Folgendes funktionieren:
    Das Ziel ist es, die Randpunkte eines beliebig geformten Shapes zu bestimmen
    - einen beliebigen, noch nicht besuchten Punkt, zu wählen und von diesem aus den Algorithmus laufen zu lassen, bis alle Punkte besucht wurden
    - Füge diesen Ausgangspunkt in eine Queue q
    - Für alle Punkte in der Queue
    -- besuche alle Nachbarn, die noch nicht besucht wurden und überprüfe, ob sie "zum aktuellen Shape" passen. Falls ja, füge den Punkt der Queue hinzu, falls nein, füge den aktuellen Punkt der Liste aller Randpunkte des Shapes hinzu

    Die Schwierigkeit an diesem Algorithmus sind zwei Punkte:
    1. Effizient herauszufinden, welche Punkte noch nicht besucht wurden
    2. überprüfen, ob ein Punkt zum aktuellen Shape gehört
    3. Außerdem kommt nach der Bestimmung der Shapes noch hinzu, dass du eine Art Interpolation über die Kanten machen musst, da du sonst nur Punkte hast, aber nichts sinnvolles damit anstellen kannst

    Der erste Punkt ist nicht ganz trivial. Für den Anfang genügt es, ein Integer-Array für jeden Pixel zu halten, der besucht wurde und zudem eine Integer-Variable, die die Zahl der ausgewerteten Punkte (ohne Dopplung) zählt. Im Array wird festgehalten, zu welchem Shape der Punkt gehört. Für das erste Shape ist der Wert 1 zu setzen, sobald der Punkt als zugehörig markiert wurde, für das zweite 2, usw. sodass 0 für "kein Shape" steht. Um den nächsten Eintrag, der noch nicht besucht wurde, zu wählen, suchst du einfach durch alle Punkte, die du nicht als besucht ausschließen kannst (was ohne Optimierung alle sind). Für Kanten, d.h. Werte, die niemandem zugehörig sind, kannst du vielleicht -1 setzen.
    Das ist zwar ineffizient und auch bei der Long-Variante musst ggf. sehr lange suchen, aber dafür ist es akkurat. Wenn du zudem zwischenspeicherst, was der letzte Ausgangspunkt war oder pro Zeile noch die Zahl der überbleibenden Punkte festhältst, ist das ggf. sogar schon recht effizient. Wenn es soweit ist, kann man da ja nochmal optimieren und auch mit Threading, usw. auffahren, wenn's ist.

    Der zweite Punkt ist so eine Sache. Während er beim verarbeiteten und gefilterten Bild eher nicht so schwer zu erkennen ist, ist es beim unbearbeiteten Bild ggf. recht schwierig, wirklich gute Kriterien zu finden, je nach Beleuchtung. Dieses Problem umschifft deine Filterung vmtl. dadurch, dass es sie gar nicht erst beachtet und somit Daten liefert, die nicht weiter verarbeitet werden können.
    Reflexion auf dem Schwarz kann ja trotzdem auftreten und ggf. entstehen da Farbverläufe oder sowas. Ebenfalls problematisch wird's, wenn Schmutz die Schrift bedeckt oder es neblig ist. Unscharf sollte das Bild auch nicht sein, weder durch Bewegungsunschärfe, noch durch falschen Fokus. Wäre praktisch, wenn man zusätzlich noch Tiefeninformation hätte, dann könnte man das auf Basis davon machen.
    Für den Anfang wird es vmtl. reichen, wenn du einfach dein gefiltertes Bild einbaust und einen Schwellwert für die Kanten definierst oder nur Schwarz akzeptierst oder sowas.

    Für die Bestimmung der Shapes wäre es vielleicht das beste, signifikante Stellen des Shapes zu suchen, d.h. Ecken und diese als Vertices festzuhalten und dann rundherum die Flächen zu identifizieren. Es gibt da viele Fälle, die möglich sind, aber auch das würde ich auf später verlagern.

    Viele Grüße
    ~blaze~
    Zu 1. reicht dort nicht ein Array mit allen besuchten Punkten? Und wenn ich einen neuen Punkt suche, prüfe ich erst mit Array.Contains ob er schon besucht wurde?
    Zu 2. Ja das ist so eine Sache, ich versuche mit Weichzeichner und AdaptiveThreshold da was rauszuholen aber an Tiefeninformationen komme ich leider nicht.

    Ist ja alles schön und gut, aber ich habe immer noch keinen genauen Algorithmus zum Boundry Tracing. Sehr hilfreich wäre sowas wie Verbaler Pseudo-Code oder sowas. Als Beispiel:
    Polys als Liste aller Polygone
    Marked als Liste aller besuchten Punkte
    Points als Liste aller Punkte

    Do
    Pol als derzeitiges Polygon
    Suche gegen den Uhrzeigersinn nach benachbarten Punkten in einem 3x3 Kernel
    ...

    Am besten das:

    ~blaze~ schrieb:


    - einen beliebigen, noch nicht besuchten Punkt, zu wählen und von diesem aus den Algorithmus laufen zu lassen, bis alle Punkte besucht wurden
    - Füge diesen Ausgangspunkt in eine Queue q
    - Für alle Punkte in der Queue
    -- besuche alle Nachbarn, die noch nicht besucht wurden und überprüfe, ob sie "zum aktuellen Shape" passen. Falls ja, füge den Punkt der Queue hinzu, falls nein, füge den aktuellen Punkt der Liste aller Randpunkte des Shapes hinzu

    Zusammen mit einem der gezeigten Algorithmen als Pseudo-Code, das wäre nett :)

    mfG Frank

    EDIT: Weiß jemand vielleicht wie man am besten bei Texterkennung vorgeht ? Also erst Vorverarbeitung(Rauschunterdrückung, Schwellwert-Verfahren, Kantenextraktion) und dann ? Erst segmentieren(k-means) und dann Konturen finden oder direkt versuchen alle Konturen zu finden, wie ich es jetzt vor habe. Als Output habe ich dann auf jeden Fall Polygone.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „xd-franky-5“ ()

    @xd-franky-5 Ich hab mal Dein Bild durch meine Bildverarbeitung laufen lassen:
    • 6x Median-Filter ("+", 5 Pixel)
    • Diskriminierung bei 133
    • 2x Dilation
    • 3x Erosion
    • 1x Dilation
    • Laplace
    • Konturfindung (die 8 unmittelbaren Nachbarn jedes gefundenen Pixels, das gefundene wird markiert, kann also nicht noch einmal gefunden werden),
    • Markierung der gefundenen Konrurzüge.
    Feddich.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Ist zwar schon etwas älter, geht aber noch:

    activevb.de/forenarchive/forum/vb-classic/suche/Vektorlaus/

    Den Algo kann man ohne weiteres auch in VB.Net realisieren.

    LG, VB3-Guru
    Es gibt nicht nur eine Lösung dieses Problems, sondern beliebig viele, die sich alle in den genannten Problemen unterscheiden dürften. Ich kann nicht beurteilen, was für dich nötig ist und was nicht. Abgesehen von der Polygonerzeugung solltest du aber alles bisherige realsieren können. Und die ist nicht so schwierig.
    Du kannst dir aber auch selbst ein paar Gedanken zu dem machen, wie es klappen könnte und wo Probleme auftreten könnten. Ich mache mir ja auch nur Gedanken, die auf einer gewissen Basis fundieren und daher vmtl. nicht ganz abwegig sind.

    Viele Grüße
    ~blaze~
    @RodFromGermany
    Eine Beschreibung warum du das machst wäre vielleicht cool. Also Median-Filter ist zur Rauschunterdrückung, da habe ich den Gausschen Weichzeichner.Bei "Diskriminierung" konnte ich im Netz leider nichts finden. Dilation vergrößert die Flächen und Erosion ist die Umkehrfunktion. Aber warum du beides anwendest ist mir nicht schlüssig. Für Laplace habe ich Canny mit Sobel. Bei Konturfindung scheiter' ich gerade, wie ich schon beschrieben habe.

    @VB3-Guru Irgendwie kann ich da nichts finden, vielleicht ein genauer Post ? :D

    @~blaze~ ja also die Vorverarbeitung des Bildes hab ich schon, aber ist sicher noch optimierbar (siehe Dilation). Und ja Gedanken hab' ich mir schon viele gemacht, bin schon seit 3 Tagen dran an der Konturverfolgung :D

    mfG Frank
    Ich melde mich nochmal zu später Stund'. Ich wollte dir @RodFromGermany nur mal zeigen, wie es bei mir aussieht, wenn ich Gray-Scale, 6x Median-Filter, 2x Dilation, 3x Erosion und 1x Dilation mache:

    (Bild1)

    Irgendwie ist mein Canny-Algorithmus kaputt, denn er sollte doch nun beim Kanten extrahieren keine Lücken mehr zeigen, aber er macht's doch UND wenn das Bild Binarisiert ist, mag er gar nicht mehr:

    (Bild2: Canny auf Bild1)


    (Bild3: Otsu-Threshold auf Bild1)


    (Bild4: Canny auf Bild3)

    Wie man auf Bild 2 und 4 sieht mag mein Canny-Algo beides nicht. Ihr könnt ihn ja mal anschauen. Ich möchte am Ende mein Code auf C# übersetzen und hier veröffentlichen mit Dokumentation, weil das was ich mache auch ein Schulprojekt ist und auch ein job zugleich. Also wäre es mir ziemlich wichtig, dass alles funktioniert. Helfer werden natürlich erwähnt ;)

    Canny-Algorithmus

    VB.NET-Quellcode

    1. Public Shared Function EdgeDetection(ByVal img As Bitmap, ByVal Method As EdgeDetectionMethod, ByVal HThreshold As Double, ByVal LThreshold As Double) As Bitmap
    2. Dim lbmp As New LBitmap(img)
    3. lbmp.Lock()
    4. If Method = EdgeDetectionMethod.Canny Then
    5. For x = 0 To img.Width - 1
    6. For y = 0 To img.Height - 1
    7. Dim Gr As Double() = GetGradient(lbmp, x, y)
    8. Dim G = Math.Abs(Gr(0)) + Math.Abs(Gr(1))
    9. Dim D As Double = Math.Abs(Math.Round(Math.Atan(Gr(1) / Gr(0)) * (180 / Math.PI) / 45) * 45)
    10. If G / 12 >= LThreshold And G / 12 <= HThreshold Then
    11. If D = 0 Then
    12. Dim lGr As Double() = GetGradient(lbmp, x - 1, y)
    13. Dim rGr As Double() = GetGradient(lbmp, x + 1, y)
    14. Dim lG = Math.Abs(lGr(0)) + Math.Abs(lGr(1))
    15. Dim rG = Math.Abs(rGr(0)) + Math.Abs(rGr(1))
    16. If lG < G AndAlso rG < G Then lbmp.SetPixel(x, y, Color.White, True) Else lbmp.SetPixel(x, y, Color.Black, True)
    17. ElseIf D = 45 Then
    18. Dim lGr As Double() = GetGradient(lbmp, x - 1, y - 1)
    19. Dim rGr As Double() = GetGradient(lbmp, x + 1, y + 1)
    20. Dim lG = Math.Abs(lGr(0)) + Math.Abs(lGr(1))
    21. Dim rG = Math.Abs(rGr(0)) + Math.Abs(rGr(1))
    22. If lG < G AndAlso rG < G Then lbmp.SetPixel(x, y, Color.White, True) Else lbmp.SetPixel(x, y, Color.Black, True)
    23. ElseIf D = 90 Then
    24. Dim lGr As Double() = GetGradient(lbmp, x, y - 1)
    25. Dim rGr As Double() = GetGradient(lbmp, x, y + 1)
    26. Dim lG = Math.Abs(lGr(0)) + Math.Abs(lGr(1))
    27. Dim rG = Math.Abs(rGr(0)) + Math.Abs(rGr(1))
    28. If lG < G AndAlso rG < G Then lbmp.SetPixel(x, y, Color.White, True) Else lbmp.SetPixel(x, y, Color.Black, True)
    29. ElseIf D = 135 Then
    30. Dim lGr As Double() = GetGradient(lbmp, x - 1, y - 1)
    31. Dim rGr As Double() = GetGradient(lbmp, x + 1, y + 1)
    32. Dim lG = Math.Abs(lGr(0)) + Math.Abs(lGr(1))
    33. Dim rG = Math.Abs(rGr(0)) + Math.Abs(rGr(1))
    34. If lG < G AndAlso rG < G Then lbmp.SetPixel(x, y, Color.White, True) Else lbmp.SetPixel(x, y, Color.Black, True)
    35. End If
    36. Else
    37. lbmp.SetPixel(x, y, Color.Black, True)
    38. End If
    39. Next
    40. Next
    41. End If
    42. lbmp.Unlock(True)
    43. Return lbmp.Bitmap
    44. End Function
    45. Private Shared Function GetGradient(ByVal img As LBitmap, ByVal x As Integer, ByVal y As Integer) As Double()
    46. Dim col As Color
    47. Dim kernelX() As Double = CreateSobelKernel(True)
    48. Dim kernelY() As Double = CreateSobelKernel(False)
    49. Dim Gx As Double = 0
    50. Dim Gy As Double = 0
    51. Dim p As Integer = 0
    52. For ky = y - 1 To y + 1
    53. For kx = x - 1 To x + 1
    54. If ky >= 0 AndAlso ky < img.Bitmap.Height AndAlso kx >= 0 AndAlso kx < img.Bitmap.Width Then
    55. col = img.GetPixel(kx, ky)
    56. Gx += col.R * kernelX(p)
    57. Gy += col.R * kernelY(p)
    58. End If
    59. p += 1
    60. Next
    61. Next
    62. Dim G As Double() = {Gx, Gy}
    63. Return G
    64. End Function
    65. Private Shared Function CreateSobelKernel(ByVal Horizontal As Boolean) As Double()
    66. Dim kernel(8) As Double
    67. If Horizontal Then kernel = {-1, 0, 1, -2, 0, 2, -1, 0, 1} Else kernel = {1, 2, 1, 0, 0, 0, -1, -2, -1}
    68. Return kernel
    69. End Function



    Hoffe, ihr könnt mir weiterhin helfen.
    mfG Frank

    xd-franky-5 schrieb:

    Eine Beschreibung warum du das machst wäre vielleicht cool.
    Sagen wir es mal so:
    Ich musste mal dunkelgraue Körper auf hellgrauem Grund finden.
    Also:
    • Median-Filter zum Eliminieren von Ausreißern, weniger zur Rauschunterdrückung.
    • Diskriminierung:
      Du machst ein Histogramm und legst da eine Schwelle rein, alles was kleiner ist, wird schwarz, alles andere weiß.
    • Dilation / Erosion (Anzahl der Summe beider = 0!):
      Es werden dünne Brücken an Rändern zu gleichfarbigen Gebieten aufgebrochen und geglättet.
    • Laplace-Filter zur Kantenfindung finde ich besser als den Sobelfilter, weil er isotrop ist.
      Die Kanten sind dann weiß auf schwarzem Grund.
    • Kantenfindung:
      Do {
      Du suchst das erste weiße Pixel (255), merkst es Dir und benennst es um in 254. Dieses hat 8 Nachbar-Pixel, von denen nur 2 weiß sein sollten.
      Nimm eins von denen und benenne es um in 254. Dieses hat 8 Nachbar-Pixel, von denen nur eines weiß sein sollte.
      Nimm es und benenne es um in 254. Dieses hat 8 Nachbar-Pixel, von denen nur eines weiß sein sollte.
      .....
      Dies machst Du so lange, bis Du auf das erste Pixel mit dem Wert 254 triffst => geschlossene Kontur gefunden
      oder
      bis Du auf den Rand triffst, dann gehst Du auf das gemerkte Pixel und machst weiter, bis Du dessen Ende findest, sollte auch ein Rand sein.

      Mache weiter, benenne aber die nächste Kontur um in 253; 252; 251 usw.
      (wenn es mehr als 254 Konturen gibt, fängst Du wieder mit 254 an)
      } Loop (solange es noch 255er Pixel gibt)
    • Hole Dir die Konturzüge raus und packe sie in welche Form auch immer.
    • Warum das alles in dieser Reihenfolge:
      rumgespielt, ausprobiert, für gut befunden.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Habe mir jetzt auch nochmal etwas Arbeit gemacht. Ich kommentiere den Code morgen nochmal, wenn ich die Zeit finde. Habe ihn jetzt etwas angetestet, hoffe er erfüllt seinen Job.
    Was jetzt noch fehlt, ist ein gutes Modell zum Bestimmen von Kanten, d.h. du solltest deinen Filter drüberlaufen lassen, bevor du die Kanten durch meinen Algorithmus laufen lässt.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Imports System.Drawing.Imaging
    2. Imports Polygonize
    3. Imports GCHandle = System.Runtime.InteropServices.GCHandle
    4. Public Class ShapeFinder
    5. Private _tolerance As Integer
    6. Public Sub New(tolerance As Integer)
    7. _tolerance = tolerance
    8. End Sub
    9. Public Iterator Function FindShapes(bitmap As Bitmap) As IEnumerable(Of Shape)
    10. If bitmap Is Nothing Then Throw New ArgumentNullException(NameOf(bitmap))
    11. Dim buffer(bitmap.Height * bitmap.Width - 1) As Integer
    12. Dim visited(bitmap.Height * bitmap.Width - 1) As Integer
    13. Dim data As BitmapData
    14. Dim gch As GCHandle = GCHandle.Alloc(buffer, Runtime.InteropServices.GCHandleType.Pinned)
    15. Try
    16. data = New BitmapData() With {.Width = bitmap.Width, .Height = bitmap.Height, .PixelFormat = PixelFormat.Format32bppArgb, .Scan0 = gch.AddrOfPinnedObject(), .Stride = 4 * bitmap.Width}
    17. data = bitmap.LockBits(New Rectangle(Point.Empty, bitmap.Size), ImageLockMode.UserInputBuffer Or ImageLockMode.ReadOnly, data.PixelFormat, data)
    18. Catch
    19. gch.Free()
    20. Throw
    21. End Try
    22. Try
    23. Dim w = data.Width, h = data.Height
    24. Dim index As Integer = 1
    25. Dim bufferWrapper As New Access2D(Of Integer)(buffer, w, h)
    26. Dim startingLine As Integer = 0
    27. Do
    28. Dim s As Shape = FindShape(bufferWrapper, New Access2D(Of Integer)(visited, w, h), index, New ShapeHandler(bufferWrapper, _tolerance), startingLine)
    29. If s Is Nothing Then
    30. Exit Do 'No more shapes available
    31. End If
    32. index += 1
    33. Yield s
    34. Loop
    35. Finally
    36. bitmap.UnlockBits(data)
    37. gch.Free()
    38. End Try
    39. End Function
    40. 'TODO: replace visited with 2D-BitArray, except if you want to asynchronously detect the list of shapes (you'd have to provide atomic operations on the array and merge overlapping shapes before returning them)
    41. Private Shared Function FindShape(buffer As Access2D(Of Integer), visited As Access2D(Of Integer), index As Integer, shapeHandler As ShapeHandler, ByRef startingLine As Integer) As Shape
    42. 'Find next position from which to search for a shape
    43. Dim p As Point = New Point(-1, -1)
    44. For y As Integer = startingLine To buffer.Height - 1
    45. For x As Integer = 0 To buffer.Width - 1
    46. If visited(x, y) <= 0 Then
    47. p = New Point(x, y)
    48. Exit For
    49. End If
    50. Next
    51. If p.X >= 0 Then Exit For 'you might want to use Goto. I don't know, how far convention recommend the use of goto nested for-loops, so I won't make use of it, here.
    52. Next
    53. If p.X < 0 Then Return Nothing
    54. startingLine = p.Y
    55. 'Start searching from the indicated position
    56. Dim shapeBounds As New List(Of Point)()
    57. Dim neighborQueue As New Queue(Of Point)()
    58. shapeHandler.Reset(p, index)
    59. visited(p.X, p.Y) = index
    60. Do
    61. If Not AcquireNeighbours(buffer, visited, p, index, neighborQueue, shapeHandler) OrElse IsBorderPoint(p, buffer.Width, buffer.Height) Then
    62. shapeBounds.Add(p)
    63. End If
    64. 'Go on from next point
    65. If neighborQueue.Count = 0 Then
    66. Exit Do
    67. End If
    68. p = neighborQueue.Dequeue()
    69. Loop
    70. Return New Shape(shapeBounds.ToArray())
    71. End Function
    72. Private Shared Function AcquireNeighbours(buffer As Access2D(Of Integer), visited As Access2D(Of Integer), position As Point, index As Integer, neighbors As Queue(Of Point), shapeHandler As ShapeHandler) As Boolean
    73. Return Acquire(buffer, visited, New Point(position.X - 1, position.Y), index, neighbors, shapeHandler) Or
    74. Acquire(buffer, visited, New Point(position.X + 1, position.Y), index, neighbors, shapeHandler) Or
    75. Acquire(buffer, visited, New Point(position.X, position.Y - 1), index, neighbors, shapeHandler) Or
    76. Acquire(buffer, visited, New Point(position.X, position.Y + 1), index, neighbors, shapeHandler) Or
    77. Acquire(buffer, visited, New Point(position.X - 1, position.Y - 1), index, neighbors, shapeHandler) Or
    78. Acquire(buffer, visited, New Point(position.X - 1, position.Y + 1), index, neighbors, shapeHandler) Or
    79. Acquire(buffer, visited, New Point(position.X + 1, position.Y - 1), index, neighbors, shapeHandler) Or
    80. Acquire(buffer, visited, New Point(position.X + 1, position.Y + 1), index, neighbors, shapeHandler)
    81. End Function
    82. Private Shared Function Acquire(buffer As Access2D(Of Integer), visited As Access2D(Of Integer), position As Point, index As Integer, neighbors As Queue(Of Point), shapeHandler As ShapeHandler) As Boolean
    83. If Not buffer.CheckLocation(position.X, position.Y) Then Return False
    84. Dim v As Integer = visited(position.X, position.Y)
    85. If v > 0 Then Return v = index
    86. If Not shapeHandler.AddPixel(position.X, position.Y) Then Return False
    87. visited(position.X, position.Y) = index
    88. neighbors.Enqueue(position)
    89. Return True
    90. End Function
    91. Private Shared Function IsBorderPoint(point As Point, width As Integer, height As Integer) As Boolean
    92. Return point.X = 0 OrElse point.Y = 0 OrElse point.X = width - 1 OrElse point.Y = height - 1
    93. End Function
    94. Private Class ShapeHandler
    95. Private _buffer As Access2D(Of Integer)
    96. Private _referenceR, _referenceG, _referenceB As Integer
    97. Private _toleranceSq As Integer
    98. Public Sub New(buffer As Access2D(Of Integer), tolerance As Integer)
    99. _buffer = buffer
    100. _toleranceSq = tolerance * tolerance
    101. End Sub
    102. Public Sub Reset(origin As Point, shapeIndex As Integer)
    103. Dim refargb As Integer = _buffer(origin.X, origin.Y)
    104. _referenceR = (refargb >> 16) And &HFF
    105. _referenceG = (refargb >> 8) And &HFF
    106. _referenceB = refargb And &HFF
    107. End Sub
    108. Public Function AddPixel(x As Integer, y As Integer) As Boolean
    109. Dim argb As Integer = _buffer(x, y)
    110. Dim r As Integer = ((argb >> 16) And &HFF) - _referenceR
    111. Dim g As Integer = ((argb >> 8) And &HFF) - _referenceG
    112. Dim b As Integer = (argb And &HFF) - _referenceB
    113. Return r * r + g * g + b * b <= _toleranceSq
    114. End Function
    115. End Class
    116. Private Structure Access2D(Of T)
    117. Public Array As T()
    118. Public Width As Integer
    119. Public Height As Integer
    120. Public Function CheckLocation(x As Integer, y As Integer) As Boolean
    121. Return x >= 0 AndAlso x < Width AndAlso y >= 0 AndAlso y < Height
    122. End Function
    123. Default Public Property Item(x As Integer, y As Integer) As T
    124. Get
    125. If Not CheckLocation(x, y) Then Throw New ArgumentException("X or y out of range.")
    126. Return Array(x + y * Width)
    127. End Get
    128. Set(value As T)
    129. If Not CheckLocation(x, y) Then Throw New ArgumentException("X or y out of range.")
    130. Array(x + y * Width) = value
    131. End Set
    132. End Property
    133. Public Sub New(array As T(), width As Integer, height As Integer)
    134. Me.Array = array
    135. Me.Width = width
    136. Me.Height = height
    137. End Sub
    138. End Structure
    139. End Class

    VB.NET-Quellcode

    1. Public Class Shape
    2. Public ReadOnly Property Points As Point()
    3. Public Sub New(points As Point())
    4. If points Is Nothing Then Throw New ArgumentNullException(NameOf(points))
    5. Me.Points = points 'or DirectCast(points.Clone(), PointF()) to prevent editing the submitted array of points by changing the entries of the Points property value
    6. End Sub
    7. End Class


    Namen waren mir jetzt btw. egal. Ich weiß, dass die schlecht benannt sind, aber ich hatte keine wirkliche Zeit und es hat mich mehr gekostet, als ich geschätzt hätte (hatte in Zeile 96 ein Verwischen hervorgerufen. Das ist auch die Zeile, von deren Richtigkeit ich nicht vollends überzeugt bin).

    Um daraus Polygone zu erzeugen, würde ich jetzt signifikante Punkte bestimmen, d.h. eben Ecken und dann zwischen diesen Ecken Geraden ziehen und schauen, wie stark Punkte zwischen den Geraden davon abweichen. Wenn sie unterhalb eines bestimmten Toleranzbereichs abweichen (der auch relativ zur Streckenlänge sein darf), würde ich sie ignorieren, sonst den Algorithmus dort ebenfalls fortsetzen.

    Viele Grüße
    ~blaze~
    @RodFromGermanynullOkay danke, ich habe die ganzen Filter jetzt mal erstellt und drüber laufen lassen. Auch Laplace hab' ich gemacht und sieht besser aus als Sobel. Und dein Konturverfolgungs-Algorithmus werde ich nun als erstes testen.
    EDIT: Hab's nicht hinbekommen :( Das müsste es doch sein ?
    Spoiler anzeigen

    VB.NET-Quellcode

    1. For y = 0 To img.Height - 1
    2. For x = 0 To img.Width - 1
    3. Dim f As Point
    4. Dim n As Integer = 254
    5. If lbmp.GetPixel(x, y).R = 255 Then
    6. f = New Point(x, y)
    7. lbmp.SetPixel(x, y, Color.FromArgb(n, 255, 255))
    8. Dim p As Point = f
    9. Dim pol As New Polygon
    10. Do
    11. For ky = f.Y - 1 To f.Y + 1
    12. For kx = f.X - 1 To f.X + 1
    13. If Not kx = x AndAlso Not ky = y AndAlso ky >= 0 AndAlso ky < img.Height AndAlso kx >= 0 AndAlso kx < img.Width Then
    14. If lbmp.GetPixel(kx, ky).R = 255 Then
    15. p = New Point(kx, ky)
    16. lbmp.SetPixel(kx, ky, Color.FromArgb(n, 255, 255))
    17. pol.Points.Add(p)
    18. ElseIf lbmp.GetPixel(kx, ky).R = n Then
    19. Exit Do
    20. End If
    21. Else
    22. Exit Do
    23. End If
    24. Next
    25. Next
    26. Loop
    27. pols.Add(pol)
    28. n -= 1
    29. End If
    30. Next
    31. Next



    @VB3-Guru danke, aber der Code sieht nicht so hilfreich aus :-/

    @~blaze~ ja, ich warte noch, bis du auskommentierst, würde das nämlich gerne verstehen :D Ist der Algorithmus von dir oder hat der 'nen Namen ?

    mfG Frank

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „xd-franky-5“ ()

    xd-franky-5 schrieb:

    VB.NET-Quellcode

    1. If Not kx = x AndAlso Not ky = y AndAlso ky >= 0 AndAlso ky < img.Height AndAlso kx >= 0 AndAlso kx < img.Width Then
    Diese Begrenzung machst Du, indem Du die beiden äußeren For-Schleifen von 1 bis LIMIT - 2 laufen lässt.
    Nur der Selbsttest bleibt drin (so isses lesbarer):

    VB.NET-Quellcode

    1. If kx <> x AndAlso ky <> y Then

    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Den Algorithmus halt eich für sehr teuer. Für ein solches Problem.
    Meiner ist andererseits von dem angemerkten Bug geplagt. Keine Ahnung, was ich da gestern getestet habe, aber es war wohl nicht richtig. Ich habe leider absolut keinen Kopf dafür, gerade.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Imports System.Drawing.Imaging
    2. Imports Polygonize
    3. Imports GCHandle = System.Runtime.InteropServices.GCHandle
    4. Public Class ShapeFinder
    5. Private _tolerance As Integer
    6. ''' <summary>
    7. ''' Initializes a new instance of the <see cref="ShapeFinder"/> type.
    8. ''' </summary>
    9. ''' <param name="tolerance">The amount of difference that is used to compare colors. See remarks for further information.</param>
    10. ''' <remarks>
    11. ''' The tolerance determines the maximum difference of the colors of the origin pixel of a shape and the currently compared pixel.
    12. ''' The origin pixel is the pixel at which the algorithm starts the determination of a shape.
    13. ''' </remarks>
    14. Public Sub New(tolerance As Integer)
    15. _tolerance = tolerance
    16. End Sub
    17. ''' <summary>
    18. ''' Searches the indicated bitmap for shapes.
    19. ''' </summary>
    20. ''' <param name="bitmap">The bitmap to scan.</param>
    21. ''' <returns>An enumeration of the found shapes.</returns>
    22. Public Iterator Function FindShapes(bitmap As Bitmap) As IEnumerable(Of Shape)
    23. If bitmap Is Nothing Then Throw New ArgumentNullException(NameOf(bitmap))
    24. Dim buffer(bitmap.Height * bitmap.Width - 1) As Integer
    25. Dim visited(bitmap.Height * bitmap.Width - 1) As Integer
    26. Dim data As BitmapData
    27. 'Copy the bitmap's pixel data into an array of 32-bit argb values
    28. Dim gch As GCHandle = GCHandle.Alloc(buffer, Runtime.InteropServices.GCHandleType.Pinned)
    29. Try
    30. data = New BitmapData() With {.Width = bitmap.Width, .Height = bitmap.Height, .PixelFormat = PixelFormat.Format32bppArgb, .Scan0 = gch.AddrOfPinnedObject(), .Stride = 4 * bitmap.Width}
    31. data = bitmap.LockBits(New Rectangle(Point.Empty, bitmap.Size), ImageLockMode.UserInputBuffer Or ImageLockMode.ReadOnly, data.PixelFormat, data)
    32. Catch
    33. gch.Free()
    34. Throw
    35. End Try
    36. Try
    37. Dim w = data.Width, h = data.Height
    38. Dim shapeIndex As Integer = 1
    39. 'Access2D wraps an array to provide 2-dimensional access
    40. Dim bufferWrapper As New Access2D(Of Integer)(buffer, w, h)
    41. Dim startingLine As Integer = 0
    42. Do
    43. 'FindShape will search for the next shape and return it.
    44. Dim s As Shape = FindShape(bufferWrapper, New Access2D(Of Integer)(visited, w, h), shapeIndex, New ShapeHandler(bufferWrapper, _tolerance), startingLine)
    45. If s Is Nothing Then
    46. Exit Do 'No more shapes available
    47. End If
    48. shapeIndex += 1
    49. Yield s
    50. Loop
    51. Finally
    52. bitmap.UnlockBits(data)
    53. gch.Free()
    54. End Try
    55. End Function
    56. 'TODO: replace visited with 2D-BitArray, except if you want to asynchronously detect the list of shapes (you'd have to provide atomic operations on the array and merge overlapping shapes before returning them)
    57. Private Shared Function FindShape(buffer As Access2D(Of Integer), pixelAssignments As Access2D(Of Integer), shapeIndex As Integer, shapeHandler As ShapeHandler, ByRef startingLine As Integer) As Shape
    58. 'Find next position from which to search for a shape
    59. 'TODO: make this more efficient
    60. 'Find the next point that has not been visited
    61. Dim p As Point = New Point(-1, -1) 'start with (-1, -1). If, after the loop, p is still (-1, -1), all pixels of the bitmap have been assigned
    62. 'go through all pixels starting from (0, startingLine). Starting line is used to accelerate the process: it keeps track of the lines that have already
    63. 'been scanned by this process
    64. For y As Integer = startingLine To buffer.Height - 1
    65. For x As Integer = 0 To buffer.Width - 1
    66. If pixelAssignments(x, y) <= 0 Then
    67. p = New Point(x, y) 'a new point has been found
    68. Exit For
    69. End If
    70. Next
    71. 'you might want to use Goto. I don't know, how far convention recommend the use of goto nested for-loops, so I won't make use of it, here
    72. 'if the next point has been determined, exit the loop
    73. If p.X >= 0 Then Exit For
    74. Next
    75. If p.X < 0 Then Return Nothing
    76. startingLine = p.Y 'Store last line that has been scanned
    77. 'Start searching from the indicated shape
    78. Dim shapeBounds As New List(Of Point)() 'keeps track of the current shape's bounds
    79. Dim neighborQueue As New Queue(Of Point)() 'keeps track of the neighbors (that are part of the current shape) that have not been handled yet
    80. shapeHandler.Reset(p, shapeIndex) 'The shape handler is used to determine, whether a pixel is a part of the current shape. Reset it to indicate a new shape.
    81. pixelAssignments(p.X, p.Y) = shapeIndex 'The previously determined pixel is marked as "assigned to the current shape"
    82. Do
    83. 'Find neighbors of the current pixel that have not been assigned and are part of the current shape
    84. 'AcquireNeighbours adds the unassigned pixel to the queue and marks it at assigned to the current shape and returns true, if successful
    85. 'If it was not successful and therefore, the pixel has been outside of the bitmap's boundaries or been assigned to another shape,
    86. 'the function returns false. If the function returns false, the pixel is considered to be a border point
    87. 'IsBorderPoint checks, whether the pixel lies on the border of the bitmap which indicates that the pixel is a border point of a shape, too
    88. Dim pixelInfo = AcquireNeighbours(buffer, pixelAssignments, p, shapeIndex, neighborQueue, shapeHandler)
    89. '>>>Wrong behaviour
    90. If pixelInfo <> PixelInfo.NoAction AndAlso (pixelInfo And PixelInfo.AcquiredNew) = 0 OrElse IsBorderPoint(p, buffer.Width, buffer.Height) Then
    91. shapeBounds.Add(p)
    92. End If
    93. 'If there aren't any neighbors left that have not been handled, return the shape...
    94. If neighborQueue.Count = 0 Then
    95. Exit Do
    96. End If
    97. '... otherwise handle the neighbor itself
    98. p = neighborQueue.Dequeue()
    99. Loop
    100. Return New Shape(shapeBounds.ToArray())
    101. End Function
    102. Private Shared Function AcquireNeighbours(buffer As Access2D(Of Integer), pixelAssignments As Access2D(Of Integer), position As Point, shapeIndex As Integer, neighbors As Queue(Of Point), shapeHandler As ShapeHandler) As PixelInfo
    103. 'Acquire all pixels around the current pixel (the first four are left, right, above, below, the second four are diagonal: above-left, below-left, above-right, below-right)
    104. Return Acquire(buffer, pixelAssignments, New Point(position.X - 1, position.Y), shapeIndex, neighbors, shapeHandler) Or
    105. Acquire(buffer, pixelAssignments, New Point(position.X + 1, position.Y), shapeIndex, neighbors, shapeHandler) Or
    106. Acquire(buffer, pixelAssignments, New Point(position.X, position.Y - 1), shapeIndex, neighbors, shapeHandler) Or
    107. Acquire(buffer, pixelAssignments, New Point(position.X, position.Y + 1), shapeIndex, neighbors, shapeHandler) Or
    108. Acquire(buffer, pixelAssignments, New Point(position.X - 1, position.Y - 1), shapeIndex, neighbors, shapeHandler) Or
    109. Acquire(buffer, pixelAssignments, New Point(position.X - 1, position.Y + 1), shapeIndex, neighbors, shapeHandler) Or
    110. Acquire(buffer, pixelAssignments, New Point(position.X + 1, position.Y - 1), shapeIndex, neighbors, shapeHandler) Or
    111. Acquire(buffer, pixelAssignments, New Point(position.X + 1, position.Y + 1), shapeIndex, neighbors, shapeHandler)
    112. End Function
    113. Private Shared Function Acquire(buffer As Access2D(Of Integer), pixelAssignments As Access2D(Of Integer), position As Point, index As Integer, neighbors As Queue(Of Point), shapeHandler As ShapeHandler) As PixelInfo
    114. If Not buffer.CheckLocation(position.X, position.Y) Then Return PixelInfo.NoAction 'if the pixel is outside the bitmap, return false
    115. Dim v As Integer = pixelAssignments(position.X, position.Y)
    116. If v > 0 Then Return If(v = index, PixelInfo.CurrentShapeNeighbor, PixelInfo.OtherShapeNeighbor)
    117. If Not shapeHandler.AddPixel(position.X, position.Y) Then Return PixelInfo.NoAction 'if the pixel should not be part of the shape due to the ShapeHandler's tolerance functionality, return false
    118. 'assign the pixel to the current shape
    119. pixelAssignments(position.X, position.Y) = index
    120. neighbors.Enqueue(position) 'and add it to the queue of neighbors that have yet to get scanned
    121. Return PixelInfo.AcquiredNew
    122. End Function
    123. Private Shared Function IsBorderPoint(point As Point, width As Integer, height As Integer) As Boolean
    124. Return point.X = 0 OrElse point.Y = 0 OrElse point.X = width - 1 OrElse point.Y = height - 1
    125. End Function
    126. Private Class ShapeHandler
    127. Private _buffer As Access2D(Of Integer)
    128. Private _referenceR, _referenceG, _referenceB As Integer
    129. Private _toleranceSq As Integer
    130. Public Sub New(buffer As Access2D(Of Integer), tolerance As Integer)
    131. _buffer = buffer
    132. _toleranceSq = tolerance * tolerance
    133. End Sub
    134. Public Sub Reset(origin As Point, shapeIndex As Integer)
    135. Dim refargb As Integer = _buffer(origin.X, origin.Y)
    136. 'extract r, g, b for the origin pixel
    137. _referenceR = (refargb >> 16) And &HFF
    138. _referenceG = (refargb >> 8) And &HFF
    139. _referenceB = refargb And &HFF
    140. End Sub
    141. Public Function AddPixel(x As Integer, y As Integer) As Boolean
    142. 'extract r, g, b for this pixel
    143. Dim argb As Integer = _buffer(x, y)
    144. Dim r As Integer = ((argb >> 16) And &HFF) - _referenceR
    145. Dim g As Integer = ((argb >> 8) And &HFF) - _referenceG
    146. Dim b As Integer = (argb And &HFF) - _referenceB
    147. 'TODO: choose better comparison algorithm
    148. 'compare the two colors |(pixelR, pixelG, pixelB) - (originR, originG, originB)|^2 <= _toleranceSq, where (v1, v2, v3) represents a vector (comparing the squares is more efficient)
    149. 'I would choose a color model with Hue, Chroma and Luma (AHCY'_601 or something like that and add the absolute value of the difference for this check or look for another comparison value that is more accurate)
    150. Return r * r + g * g + b * b <= _toleranceSq
    151. End Function
    152. End Class
    153. <Flags()>
    154. Private Enum PixelInfo
    155. NoAction = 0
    156. AcquiredNew = 1
    157. CurrentShapeNeighbor = 2
    158. OtherShapeNeighbor = 4
    159. End Enum
    160. Private Structure Access2D(Of T)
    161. Public Array As T()
    162. Public Width As Integer
    163. Public Height As Integer
    164. Public Function CheckLocation(x As Integer, y As Integer) As Boolean
    165. Return x >= 0 AndAlso x < Width AndAlso y >= 0 AndAlso y < Height
    166. End Function
    167. Default Public Property Item(x As Integer, y As Integer) As T
    168. Get
    169. If Not CheckLocation(x, y) Then Throw New ArgumentException("X or y out of range.")
    170. Return Array(x + y * Width)
    171. End Get
    172. Set(value As T)
    173. If Not CheckLocation(x, y) Then Throw New ArgumentException("X or y out of range.")
    174. Array(x + y * Width) = value
    175. End Set
    176. End Property
    177. Public Sub New(array As T(), width As Integer, height As Integer)
    178. Me.Array = array
    179. Me.Width = width
    180. Me.Height = height
    181. End Sub
    182. End Structure
    183. End Class

    An der mit >>> markierten Stelle liegt der Fehler. Das Problem ist, dass bereits besuchte Kanten fälschlicherweise ebenfalls als Grenze erkannt werden mit der aktuellen Konfiguration.

    Edit: Der Fehler sollte übrigens einfach zu beheben sein. Ach ja, der Algorithmus ist übrigens von mir und von der Arbeitsweise her auch nicht optimal. Nur glaube ich, dass der an dieser Stelle brauchbare Resultate liefert und einfacher ist, als das, was ich sonst vorgeschlagen hätte.

    Viele Grüße
    ~blaze~

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „~blaze~“ ()

    @RodFromGermany okay habe das mal geändert und den Code bisschen erweitert aber es kommt noch immer nichts dabei raus:
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Dim pols As New List(Of Polygon)
    2. Dim n As Integer = 254
    3. Do While n > 0
    4. For y = 1 To img.Height - 2
    5. For x = 1 To img.Width - 2
    6. Dim f As Point
    7. If lbmp.GetPixel(x, y).R = 255 Then
    8. f = New Point(x, y)
    9. lbmp.SetPixel(x, y, Color.FromArgb(n, 255, 255))
    10. Dim p As Point = f
    11. Dim pol As New Polygon
    12. Do
    13. For ky = p.Y - 1 To p.Y + 1
    14. For kx = p.X - 1 To p.X + 1
    15. Dim whites As New List(Of Point)
    16. If kx <> x AndAlso ky <> y Then
    17. If lbmp.GetPixel(kx, ky).R = 255 Then
    18. whites.Add(New Point(kx, ky))
    19. ElseIf lbmp.GetPixel(kx, ky).R = n Then
    20. Exit Do
    21. End If
    22. End If
    23. If whites.Count > 0 Then
    24. p = whites(0)
    25. lbmp.SetPixel(whites(0).X, whites(0).Y, Color.FromArgb(n, 255, 255))
    26. pol.Points.Add(p)
    27. Else
    28. Exit Do
    29. End If
    30. Next
    31. Next
    32. Loop
    33. pols.Add(pol)
    34. If n > 0 Then n -= 1 Else Exit Do
    35. End If
    36. Next
    37. Next
    38. Loop



    @~blaze~ hm ich steig da irgendwie nicht durch, ist mir glaub' ich zu hoch geschrieben. Der Algorithmus den ich ganz am Anfang hatte funktioniert bei mir gerade am besten, also er gibt die längsten Pfade zurück, aber er gibt mir immer zwei, einen auf der linken Seite der Linie und einen auf der rechten Seite.

    mfG Frank

    EDIT:
    hier mal der Vergleich:

    (Original, gefiltert)


    (Mein erster Versuch)


    (~blaze~' Algorithmus)


    (Rods Algorithmus, mein Versuch)


    (Square Trace)


    EDIT 2: Habe nochmal was versucht und das sieht bis jetzt am besten aus:


    Hat aber das Problem, dass es sich an schwierigen Stellen verläuft. Habe auch herausgefunden, dass es Stellen sind, an denen Schräge Kanten nicht ein Pixel dünn sind. Also muss ich irgendwie die Linien ausdünnen. ODER ich lasse zusammengehörende Konturen zusammenfügen.

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „xd-franky-5“ ()

    xd-franky-5 schrieb:

    VB.NET-Quellcode

    1. whites.Add(New Point(kx, ky))
    Du sollst die 255er nicht zählen, sondern den ersten markieren und raus.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Funktioniert trotzdem nicht :-/ und wie gesagt, habe nun einen neuen Algorithmus, der bisher am besten funktioniert und den werde ich jetzt noch ein wenig ausbauen bis zur Veröffentlichung.

    @Morrison Ja das sind Edge Detection Filter, einen solchen habe ich bereits. Es geht um Konturverfolgung :) Trotzdem danke.

    mfG Frank