11-13-2025, 03:45 PM
Program for detecting image edges. Returns an array of edge points.
Code: (Select All)
' ---------------------------
' Border detect 0.1
' ---------------------------
Screen _NewImage(800, 600, 256)
Randomize Timer
Do
Locate 1
'draw random image (1 color, is enought as mask)
For f = 1 To 5000
If Rnd * 4 > 5 Then p = -1 Else p = 1
x = 200 + Rnd * p * 300
y = 200 + Rnd * p * 200
r = (10 + f / 250) * Rnd
CircleFill x, y, r, 40
Next
' prepare output arrays
ReDim Bx(0) As Integer, By(0) As Integer
ReDim count As Long
' use _Dest as source image, because image is draw directly to screen in previous step
DetectBorder _Dest, 40, Bx(), By(), count
_Dest 0
Print "Generate random picture in 1 color and detect the border (white). ESC for end."
Print "Border points (count):"; count
' draw detected border points
If count >= 0 Then
For d = 0 To count
Line (Bx(d), By(d))-(Bx(d) + 1, By(d) + 1), , BF 'draw detected border in white color
Next
End If
_Limit 1
Cls
Print "Generate random picture in 1 color and detect the border (white)."
Loop Until _KeyDown(27)
' ---------------------------------------------
' Boundary test function
' Returns -1 if pixel is boundary, 0 otherwise
' ---------------------------------------------
Function IsBoundary (px As Long, py As Long, targetColor As Integer, src As Long, W As Long, H As Long, dx() As Integer, dy() As Integer)
' outside = boundary
If px < 0 Or px >= W Or py < 0 Or py >= H Then
IsBoundary = -1
Exit Function
End If
_Source src
If Point(px, py) <> targetColor Then
IsBoundary = 0
Exit Function
End If
' at least one neighbor must differ -> boundary
For k = 0 To 7
nx = px + dx(k)
ny = py + dy(k)
If nx < 0 Or nx >= W Or ny < 0 Or ny >= H Then
IsBoundary = -1
Exit Function
Else
_Source src
If Point(nx, ny) <> targetColor Then
IsBoundary = -1
Exit Function
End If
End If
Next
IsBoundary = 0
End Function
' ---------------------------------
' Moore-neighborhood border tracer
' ---------------------------------
Sub DetectBorder (src As Long, targetColor As Integer, bx() As Integer, by() As Integer, bcnt As Long)
Dim dx(7) As Integer, dy(7) As Integer
dx(0) = 1: dy(0) = 0 ' East
dx(1) = 1: dy(1) = 1 ' SE
dx(2) = 0: dy(2) = 1 ' South
dx(3) = -1: dy(3) = 1 ' SW
dx(4) = -1: dy(4) = 0 ' West
dx(5) = -1: dy(5) = -1 ' NW
dx(6) = 0: dy(6) = -1 ' North
dx(7) = 1: dy(7) = -1 ' NE
W = _Width(src)
H = _Height(src)
_Source src
' 1) find first boundary pixel
found = 0
For yy = 0 To H - 1
For xx = 0 To W - 1
If Point(xx, yy) = targetColor Then
If IsBoundary(xx, yy, targetColor, src, W, H, dx(), dy()) Then
sx = xx: sy = yy
found = -1
Exit For
End If
End If
Next
If found Then Exit For
Next
If found = 0 Then
bcnt = -1
Exit Sub
End If
' 2) preallocate storage and prevent overflow
maxPts = W * H
ReDim bx(maxPts - 1) As Integer
ReDim by(maxPts - 1) As Integer
' 3) initialize tracker
x = sx: y = sy
prevX = sx - 1: prevY = sy
startPrevX = prevX: startPrevY = prevY
idx = 0
Do
If idx >= maxPts Then Exit Do
bx(idx) = x
by(idx) = y
idx = idx + 1
' find direction to previous pixel
dirPrev = -1
For d = 0 To 7
If x + dx(d) = prevX And y + dy(d) = prevY Then
dirPrev = d
Exit For
End If
Next
If dirPrev = -1 Then dirPrev = 4
' search next boundary neighbor
foundNext = 0
For k = 1 To 8
i = (dirPrev + k) Mod 8
nx = x + dx(i)
ny = y + dy(i)
If nx >= 0 And nx < W And ny >= 0 And ny < H Then
If IsBoundary(nx, ny, targetColor, src, W, H, dx(), dy()) Then
prevX = x: prevY = y
x = nx: y = ny
foundNext = -1
Exit For
End If
End If
Next
If foundNext = 0 Then Exit Do
Loop Until (x = sx And y = sy And prevX = startPrevX And prevY = startPrevY)
If idx = 0 Then
bcnt = -1
Else
bcnt = idx - 1
End If
End Sub
' ---------------------------------------------
' Fast filled circle - SMcNeill gold standard
' ---------------------------------------------
Sub CircleFill (CX As Long, CY As Long, R As Long, C As Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub