# Edge Detection

I needed a fast way to trace the edge of a colored shape and return an array of points compatible with the XOJO DrawPolygon
and for those of you that also need something… here it is

``````SUB find_edge(pt as point_record)
Dim px As Integer
Dim py As Integer
Dim stepX As Integer
Dim stepY As Integer
Dim prevX As Integer
Dim prevY As Integer
Dim closedLoop As Boolean
Dim squarevalue As Integer
Dim startpoint As point_record
// getting the starting pixel
startPoint=pt
// move up until we have LEFT the area
//
pX=startPoint.x
pY=startPoint.y
do
pY=py-1
if py<0 then exit do
if not Color_Compare1(px,py) then exit do
loop
py=py+1
startpoint=Point_of(px,py)
// if we found a starting pixel we can begin

// closedLoop will be true once we traced the full contour
closedLoop=False
While Not closedLoop
// the core of the script is getting the 2x2 square value of each pixel
squareValue=getSquareValue(pX,pY)
Select Case squareValue
// going UP with these cases:
//+---+---+   +---+---+   +---+---+
//| 1 |   |   | 1 |   |   | 1 |   |
//+---+---+   +---+---+   +---+---+
//|   |   |   | 4 |   |   | 4 | 8 |
//+---+---+   +---+---+   +---+---+
Case 1,5,13
stepX=0
stepY=-1
//going DOWN with these cases:
//+---+---+   +---+---+   +---+---+
//|   |   |   |   | 2 |   | 1 | 2 |
//+---+---+   +---+---+   +---+---+
//|   | 8 |   |   | 8 |   |   | 8 |
//+---+---+   +---+---+   +---+---+
Case 8,10,11
stepX=0
stepY=1
//going LEFT with these cases:
//+---+---+   +---+---+   +---+---+
//|   |   |   |   |   |   |   | 2 |
//+---+---+   +---+---+   +---+---+
//| 4 |   |   | 4 | 8 |   | 4 | 8 |
//+---+---+   +---+---+   +---+---+
Case 4,12,14
stepX=-1
stepY=0
//going RIGHT with these cases:
//+---+---+   +---+---+   +---+---+
//|   | 2 |   | 1 | 2 |   | 1 | 2 |
//+---+---+   +---+---+   +---+---+
//|   |   |   |   |   |   | 4 |   |
//+---+---+   +---+---+   +---+---+
Case 2,3,7
stepX=1
stepY=0
Case 6
//+---+---+
//|   | 2 |
//+---+---+
//| 4 |   |
//+---+---+
//going LEFT if coming from UP
///else going RIGHT
If (prevX=0 And prevY=-1) Then
stepX=-1
stepY=0
Else
stepX=1
stepY=0
End If
Case 9
// special saddle point case 2:
//+---+---+
//| 1 |   |
//+---+---+
//|   | 8 |
//+---+---+
//going UP if coming from RIGHT
//else going DOWN
If (prevX=1 And prevY=0)  Then
stepX=0
stepY=-1
Else
stepX=0
stepY=1
End If
End Select
//
// moving onto next point
pX=px+stepX
pY=py+stepY
// saving edge point
theEDGE.append px
theEDGE.append py

prevX=stepX
prevY=stepY

// if we returned to the first point visited, the loop has finished
If (pX=startPoint.x And pY=startPoint.y) Then closedLoop=True
Wend
END SUB``````
``````FUNCTION GetSquareValue(px as integer,py as integer) as integer
dim squareValue as integer
//checking the 2x2 pixel grid, assigning these values to each pixel, if not transparent

//+---+---+
//| 1 | 2 |
//+---+---+
//| 4 | 8 | <- current pixel (pX,pY)
//+---+---+
squareValue=0
// checking upper left pixel
if Color_Compare1(pX-1,pY-1) then squareValue=squarevalue+1

// checking upper pixel
if Color_Compare1(pX,pY-1) then squareValue=squarevalue+2

// checking left pixel
if Color_Compare1(pX-1,pY) then squareValue=squarevalue+4

// checking the pixel itself
if Color_Compare1(pX,pY) then squareValue=squarevalue+8

return squareValue
END FUNCTION``````
``````FUNCTION color_compare1(xx as integer,yy as integer) as boolean
Dim px As Color
If xx>=0 And yy>=0 And xx<work_area.Width Or yy<work_area.Height Then

px=temp_rs.Pixel(xx,yy)
Return (px=seed)
Else
Return False
End If
END FUNCTION``````

Point_Record is a simple structure X as Integer,Y as integer

Here is the text code I call it with … modify as required… I am providing the code implementation… up to you to adapt appropriately

``````SUB Magic_Wand(pt as point_record) // pt is where the user clicked on the image (work_area)
#If Not DebugBuild
#pragma DisableBoundsChecking
#pragma DisableAutoWaitCursor
#pragma StackOverflowchecking False
#pragma NilObjectChecking False
#EndIf
//msgbox "Magic Wand not ready yet"
Dim x As Integer
Dim y As Integer
Dim work_rs As RGBSurface
Dim work_temp As picture

Dim ms As Double
ms=Microseconds
x=pt.x
y=pt.y
// transfer picture to a temp area
work_temp=New picture(work_area.Width,work_area.Height,32)
myDrawPicture work_temp.Graphics,work_area,0,0
temp_rs=work_temp.RGBSurface
work_rs=work_area.RGBSurface
seed=work_rs.Pixel(x,y)
//
//flood_fill x,y
Redim theEDGE(-1)
theEDGE.Append 0
Find_Edge Point_of(x,y)

work_temp.Graphics.ForeColor=&cff0000
work_temp.Graphics.DrawPolygon theEDGE

Dim f As FolderItem
f=SpecialFolder.Desktop.child("xyz.png")
work_temp.save(f,picture.SaveAsPNG)

MsgBox "Complete "+Str((Microseconds-ms)/1000000)``````

I know you don’t like plugins but I think the Einhuger plugin has something like that (and works in realtime). Worth checking.

have a look at this…

http://alwaysbusycorner.wordpress.com/2011/12/02/realbasic-canvas-tutorial-lesson-11-edge-detection-kernel-builder/

blob detection too