Getting shape coordinates.

Hi, I have a problem:

I have an image of a square (for example). I want to get the coordinates of the square into an array of points.
A bit like a shape created by a “join the dots” kind of thing.

How the hell do I do this?

I’ve thought of scanning pixel by pixel across the image but this doesn’t give me a point to point array.

The purpose of this is I’ve built an application you can add shapes to on the form.
So I want to be able to draw the shapes in ms paint, then get the coordinates and import them into my application at runtime.
Just solid shapes are all I need.
LVL 10
Kinger247Asked:
Who is Participating?
 
Bob LearnedCommented:
Oh, now I get it.  You want to pick out a shape from a drawn Bitmap.  GetPixel is not the fastest method for scanning Bitmaps.  Bob Powell describes a faster method, using LockBits and BitmapData, in this article:

Using the LockBits method to access image data
http://www.bobpowell.net/lockingbits.htm

"Using the LockBits method to access image data
Many image processing tasks and even file type conversions, say from 32 bit-per-pixel to 8 bit-per-pixel can be speeded up by accessing the pixel data array directly, rather than relying on GetPixel and SetPixel or other methods."
Dim x As Integer
Dim y As Integer
Dim PixelSize As Integer = 4
Dim bmd As BitmapData = bm.LockBits(new Rectangle(0, 0, 10, 10), System.Drawing.Imaging.ImageLockMode.ReadOnly, bm.PixelFormat)

For y = 0 To bmd.Height - 1
    For x = 0 To bmd.Width - 1
       Marshal.WriteByte(bmd.Scan0, (bmd.Stride * y) + (4 * x) , 255)
    Next
Next

Open in new window

0
 
Kinger247Author Commented:
Ok, typical I ponder over something for hours then post something on here, then a quick visit to the loo and I Ive found how to do it !!!

I'll post the code after :)
0
 
Bob LearnedCommented:
Were you talking about creating polygons?  
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
omegaomegaDeveloperCommented:
Or possibly something more scatological?  ;-)

The coordinates of a square are pretty simple, so I suspect this is just an illustration of more complex shapes that you might need to deal with.  Is the GraphicsPath.PathPoints of any possible use to you?

Cheers,
Randy
0
 
Kinger247Author Commented:
Ok, this is what I cam up with.

If you create a black outline of an image in ms paint, like a square or one of the predefined shapes like star etc.
It'll recreate the image in a point to point array.

Might be a better way of doing it but this is my quick solution.
Pretty fast too.
Public Class Form1
  Public oMapImage As New MapImage
  Private oPoints() As Point = Nothing

  Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Dim Background As New Bitmap("C:\Data\Development Tests\Get Image Regions\Image1.bmp")
    oPoints = oMapImage.Map(Background)
  End Sub

  Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
    If oPoints Is Nothing Then Exit Sub

    Using gr As Graphics = e.Graphics
      gr.Clear(Color.White)
      gr.DrawLines(Pens.Black, oPoints)
    End Using
  End Sub
End Class

Public Class MapImage
  Private oPoints() As Point = Nothing

  Public Function Map(ByVal Background As Bitmap) As Point()
    Dim MatrixStart As Point = Nothing
    Dim MatrixCentre As New Point(-1, -1)
    Dim PreviousPoint As Point = Nothing
    Dim Finished As Boolean = False
    Dim Y As Integer = 0
    Dim X As Integer = 0
    Dim FirstWhiteCell As Boolean = False
    Dim iPosToCheck As Integer = 1
    Dim BackgroundColor As Color = Background.GetPixel(0, 0)

    '//-- Get first black pixel - scan pixels left to right / top to bottom
    For Y = 0 To Background.Width - 1
      For X = 0 To Background.Height - 1
        If Background.GetPixel(X, Y).ToArgb <> BackgroundColor.ToArgb Then
          '//-- Add first point to array !
          MatrixCentre = AddPoint(X, Y)
          Exit For
        End If
      Next
      If MatrixCentre.X <> -1 Then Exit For
    Next

    '//-- Worm your way around the pixel to find the next black pixel clockwise starting with the current
    MatrixStart = MatrixCentre
    While Not Finished
      FirstWhiteCell = False

      Do
        Select Case iPosToCheck
          Case 1 : X = MatrixCentre.X - 1 : Y = MatrixCentre.Y
          Case 2 : X = MatrixCentre.X - 1 : Y = MatrixCentre.Y - 1
          Case 3 : X = MatrixCentre.X : Y = MatrixCentre.Y - 1
          Case 4 : X = MatrixCentre.X + 1 : Y = MatrixCentre.Y - 1
          Case 5 : X = MatrixCentre.X + 1 : Y = MatrixCentre.Y
          Case 6 : X = MatrixCentre.X + 1 : Y = MatrixCentre.Y + 1
          Case 7 : X = MatrixCentre.X : Y = MatrixCentre.Y + 1
          Case 8 : X = MatrixCentre.X - 1 : Y = MatrixCentre.Y + 1
        End Select

        If Background.GetPixel(X, Y).ToArgb = BackgroundColor.ToArgb Then FirstWhiteCell = True
        If FirstWhiteCell AndAlso Background.GetPixel(X, Y).ToArgb <> BackgroundColor.ToArgb Then
          '//-- Add next point to array !
          MatrixCentre = AddPoint(X, Y)

          Select Case iPosToCheck
            Case 1 : iPosToCheck = 5
            Case 2 : iPosToCheck = 6
            Case 3 : iPosToCheck = 7
            Case 4 : iPosToCheck = 8
            Case 5 : iPosToCheck = 1
            Case 6 : iPosToCheck = 2
            Case 7 : iPosToCheck = 3
            Case 8 : iPosToCheck = 4
          End Select

          FirstWhiteCell = False

          If MatrixStart = MatrixCentre Then
            Finished = True
            Exit Do
          End If
        Else
          iPosToCheck += 1
          If iPosToCheck > 8 Then iPosToCheck = 1
        End If
      Loop

    End While

    Return oPoints
  End Function

  Private Function AddPoint(ByVal X As Integer, ByVal Y As Integer) As Point
    If oPoints Is Nothing Then
      ReDim oPoints(0)
      oPoints(0).X = X
      oPoints(0).Y = Y
    Else
      Dim Counter As Integer = oPoints.Length
      ReDim Preserve oPoints(Counter)
      oPoints(Counter).X = X
      oPoints(Counter).Y = Y
    End If

    Return New Point(X, Y)
  End Function
End Class

Open in new window

0
 
Kinger247Author Commented:
Wow, not seen that before thanks.
0
 
Bob LearnedCommented:
I would think that you might benefit more optimizations.  

1) Use generics--List(Of Point), and list.Add(point)

2) If you are just building points to redraw a line, you might be able to remove points that are on a similar line, so that you only have the end-points.  Determine direction of line, by comparing two points, and see if Math.Abs(x1 - x2) < tolerance or if Math.Abs(y1 - y2) < tolerance.

Example:
(1, 1)
(1, 2)
(1, 3)
(1, 4)

would become just (1, 1) and (1, 4)
0
 
Kinger247Author Commented:
TheLearnedOne, you are genius once again !

Never used List before, so good to learn something new.

I was trying to work out how I was going to remove duplicate points too, my idea wasn’t as tidy as yours though!

Cheers for your help !
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.