Quote Originally Posted by Schmidt View Post
Had this problem still on my "stack" (because it's interesting enough)...

Whilst Reexre brought up a professional algo in post 7 already -
below is a somewhat simpler approach with a modified "FloodFill"-routine
(which gobbles up all the found Pixel-Coords in a Dictionary-Object, not changing any Pixels in the underlying Surface).

The algo can Select and quite reliably make distinctions between the following Shape-Types:
- Rectangle
- Square
- Ellipse
- Circle
- Triangle
- Star

Here is the Demo-Code for an empty Form (requires a Reference to the RC6-library):
Code:
Option Explicit 'Demo needs a RC6-Project-Reference

Private CC As cCairoContext

Private Sub Form_Load()
  ScaleMode = vbPixels: AutoRedraw = True
  Set CC = Cairo.CreateSurface(640, 480).CreateContext
      CC.Paint 1, Cairo.CreateCheckerPattern
      CC.Rectangle 80, 50, 32, 32
      CC.Rectangle 280, 40, 25, 50
      CC.Ellipse 150, 150, 32, 32 'Circle
      CC.DrawRegularPolygon 250, 150, 25, 5, splSmall, 7
      CC.DrawRegularPolygon 50, 150, 25, 3, splSmall, 11
      CC.Ellipse 190, 60, 40, 25 'Ellipse
      
      CC.Fill , Cairo.CreateSolidPatternLng(vbRed)
  Set Picture = CC.Surface.Picture
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim Pxl() As Long, Coords As cSortedDictionary
  CC.Surface.BindToArrayLong Pxl
    Set Coords = FloodFillGetCoords(Pxl, X, Y)
  CC.Surface.ReleaseArrayLong Pxl
  
  AnalyzeCoords Coords
End Sub

Private Sub AnalyzeCoords(Coords As cSortedDictionary)
  Dim XY, xMin&, xMax&, yMin&, yMax&, dx&, dy&
  XY = Coords.ItemByIndex(0) 'get the first coord from the Dictionary
  xMin = XY(0): xMax = XY(0) 'and init the Min-Max-Coords...
  yMin = XY(1): yMax = XY(1)
  For Each XY In Coords 'before determining the final Min/Max in a loop
    If XY(0) < xMin Then xMin = XY(0)
    If XY(0) > xMax Then xMax = XY(0)
    If XY(1) < yMin Then yMin = XY(1)
    If XY(1) > yMax Then yMax = XY(1)
  Next
  
  Cls 'draw the current selection (according to the found min-max-points)
    Line (xMin - 1, yMin - 1)-(xMax + 1, yMax + 1), vbGreen, B
  Refresh
  
  'now the Area-Analysis
  dx = xMax - xMin + 1: dy = yMax - yMin + 1
  Select Case Coords.Count / (dx * dy) 'compare ratio of found Pixels (as percentage of the Rect-Area)
    Case 0.9 To 1.1: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Square", "Rectangle") & " " & Format(Coords.Count / (dx * dy), "Percent")
    Case 0.7 To 0.9: Caption = IIf(dx / dy > 0.95 And dx / dy < 1.05, "Circle", "Ellipse") & " " & Format(Coords.Count / (dx * dy), "Percent")
    Case 0.5 To 0.7: Caption = "Triangle " & Format(Coords.Count / (dx * dy), "Percent")
    Case Else:       Caption = "Star-Shaped " & Format(Coords.Count / (dx * dy), "Percent")
  End Select
End Sub

Private Function FloodFillGetCoords(Pxl() As Long, ByVal X&, ByVal Y&) As cSortedDictionary
  Set FloodFillGetCoords = New_c.SortedDictionary
  Dim S As cArrayList, Color As Long, XY
  Set S = New_c.ArrayList(vbVariant)
      S.Push Array(X, Y) 'push the Entry-Point-Coords
      Color = Pxl(X, Y)  'and set the Color to search for
      
  Do While S.Count 'as long as there's something in the Stack, keep looping
     XY = S.Pop: X = XY(0): Y = XY(1) 'pop the current x/y coords
     
     If X >= 0 And X <= UBound(Pxl, 1) And Y >= 0 And Y <= UBound(Pxl, 2) Then 'ArrayBounds-check
        If Pxl(X, Y) = Color And Not FloodFillGetCoords.Exists(X & "," & Y) Then 'Color- and Exists-Test
           FloodFillGetCoords.Add X & "," & Y, XY 'point found at x,y, add it to the Dictionary
           S.Push Array(X, Y + 1) 'push additional check-coords around the current Point
           S.Push Array(X, Y - 1)
           S.Push Array(X + 1, Y)
           S.Push Array(X - 1, Y)
        End If
     End If
  Loop
End Function
HTH

Olaf
Surface color can. Color gradient changes？