FB code:
Code: Select all
'Original code from https://github.com/halfmonty/StringArtGenerator
'Converted to FB in cooperation with ChatGPT by UEZ :-)
'Build 2025-04-23
#include "file.bi"
#include "crt/math.bi"
#include "fbgfx.bi"
Using FB
'parameters
Const bSEPIA = False 'only available when bCOLOR = False
Const bCOLOR = True 'if false than greyscale
Const bINVERS = False
Const bAA = False 'anti-aliased lines
Const bBORDER = False 'draw border around completed result
Const bAUTOSEGMENTS = True
Dim Shared As UShort SEGMENTS = 30 'line segments from pin to pin (only color mode)
Const BORDERCLR = &hA0101010
Const BORDERSIZE = 4
Const PINS = 360 'the higher the value the higher the memory consumption!
Const ALPHA_CHANNEL = &h14
Const LINE_WEIGHT = 9 'the lower the value the more lines will be drawn
Const TUNINGFACTOR = 36 'less means less details
Const CONTRASTFACTOR = 1.666666 'for color adjustment
Const MINLENGTH = 30
Const BGCOLOR = &hFFFFFFFF
Const bSAVERESULT = False
Var FILENAME = Str(ExePath & "\StringArt.bmp")
Union _Color '...'
As ULong argb
Type
As UByte b, g, r, a
End Type
End Union
#define _Alpha(iCol) ((iCol And &hFF000000) Shr 24)
#define _Red(iCol) ((iCol And &h00FF0000) Shr 16)
#define _Green(iCol) ((iCol And &h0000FF00) Shr 8)
#define _Blue(iCol) ((iCol And &h000000FF))
Function ColBlend(col1 As ULong, col2 As ULong, blend As Single) As ULong '...'
Dim As Single bl = 1 - blend
Return RGBA(_Red(col1) * blend + _Red(col2) * bl, _Green(col1) * blend + _Green(col2) * bl, _Blue(col1) * blend + _Blue(col2) * bl, _Alpha(col1) * blend + _Alpha(col2) * bl)
End Function
#define fpart(x) (Frac(x))
#define rfpart(x) (1 - Frac(x))
'https://en.wikipedia.org/wiki/Xiaolin_Wu%27s_line_algorithm
Sub DrawLineAAWu(x0 As Long, y0 As Long, x1 As Long, y1 As Long, _col As ULong, pImage As Any Ptr = 0) '...'
Dim As Boolean steep = Abs(y1 - y0) > Abs(x1 - x0)
If steep Then
Swap x0, y0
Swap x1, y1
End If
If x0 > x1 Then
Swap x0, x1
Swap y0, y1
End If
Dim As Long dx_, dy, xend, yend, xgap, xpxl1, ypxl1, xpxl2, ypxl2
Dim As Single gradient, intery, f
Dim As ULong _rgb = _col And &h00FFFFFF
Dim As UByte a = _Alpha(_col)
dx_ = x1 - x0
dy = y1 - y0
gradient = dy / dx_
If dx_ = 0 Then gradient = 1
'handle first endpoint
xend = round(x0)
yend = y0 + gradient * (xend - x0)
xgap = rfpart(x0)
xpxl1 = xend
ypxl1 = floor(yend)
If steep Then
f = rfpart(yend) * xgap
PSet pImage, (ypxl1, xpxl1), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
PSet pImage, (ypxl1 + 1, xpxl1), (a * f) Shl 24 Or _rgb
Else
f = rfpart(yend) * xgap
PSet pImage, (xpxl1, ypxl1), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
PSet pImage, (xpxl1, ypxl1 + 1), (a * f) Shl 24 Or _rgb
End If
intery = yend + gradient
'handle second endpoint
xend = round(x1)
yend = y1 + gradient * (xend - x1)
xgap = rfpart(x1)
xpxl2 = xend
ypxl2 = floor(yend)
If steep Then
f = rfpart(yend) * xgap
PSet pImage, (ypxl2, xpxl2), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
PSet pImage, (ypxl2 + 1, xpxl2), (a * f) Shl 24 Or _rgb
Else
f = rfpart(yend) * xgap
PSet pImage,(xpxl2, ypxl2), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
PSet pImage, (xpxl2, ypxl2 + 1), (a * f) Shl 24 Or _rgb
End If
'main line
If steep Then
For x As Short = xpxl1 + 1 To xpxl2 - 1
f = rfpart(intery)
PSet pImage, (floor(intery), x), (a * f) Shl 24 Or _rgb
f = fpart(intery)
PSet pImage, (floor(intery) + 1, x), (a * f) Shl 24 Or _rgb
intery += gradient
Next
Else
For x As Short = xpxl1 + 1 To xpxl2 - 1
f = rfpart(intery)
PSet pImage, (x, floor(intery)), (a * f) Shl 24 Or _rgb
f = fpart(intery)
PSet pImage, (x, floor(intery) + 1), (a * f) Shl 24 Or _rgb
intery += gradient
Next
End If
End Sub
Sub CenterFBWin(iW As Long, iH As Long, iTBw As Long = 0, iTBh As Long = 0) 'centers the FB-GUI on the primary screen '...'
Dim As Long iScreenWidth, iScreenHeight
ScreenControl GET_DESKTOP_SIZE, iScreenWidth, iScreenHeight
ScreenControl SET_WINDOW_POS, (iScreenWidth - iW) \ 2 - iTBw, (iScreenHeight - iH) \ 2 - iTBh
End Sub
Dim Shared As Integer IMG_SIZE, IMG_SIZE_SQ, MIN_DISTANCE, MAX_LINES, iDrawn
Dim Shared As ULong colorImage()
Const PI = Acos(-1)
Type Coord
x As Integer
y As Integer
End Type
Dim Shared pin_coords(PINS - 1) As Coord
Dim Shared As UByte sourceImage()
Dim Shared As Integer errorImage()
Dim Shared As Integer line_cache_x()
Dim Shared As Integer line_cache_y()
Dim Shared As Integer line_cache_len(PINS * PINS - 1)
Type tBitmap_Header Field = 1 '54 bytes '...'
As UShort bfType 'for windows bitmap it must be 19778 (&h4D42) aka "BM" in little-endian format
As Long bfSize
As ULong bfReserved
As ULong bfOffBits
As ULong biSize
As Long biWidth
As Long biHeight
As UShort biPlanes
As UShort biBitCount
As ULong biCompression
As ULong biSizeImage
As Long biXPelsPerMeter
As Long biYPelsPerMeter
As ULong biClrUsed
As ULong biClrImportant
End Type
Function GetBitmapHeaderInfo(filename As String) As tBitmap_Header
Dim As tBitmap_Header BmpInfo
If FileExists(filename) = 0 Then Return BmpInfo
Dim As Integer f
f = FreeFile
Open filename For Binary As #f
Get #f, , BmpInfo
Close #f
Return BmpInfo
End Function
Sub GetImgDim(sFilename As String, ByRef imgWidth As Long = 0, ByRef imgHeight As Long = 0)
Dim As tBitmap_Header BmpInfo
BmpInfo = GetBitmapHeaderInfo(sFilename)
imgWidth = BmpInfo.biWidth
imgHeight = BmpInfo.biHeight
End Sub
Function EstimateMaxLines() As Integer '...'
Dim As Integer sumErr = 0
Dim As _Color c
Dim As Double luminance
For i As Integer = 0 To IMG_SIZE_SQ - 1
If bCOLOR Then
c.argb = colorImage(i)
luminance = 0.299 * c.r + 0.587 * c.g + 0.114 * c.b
sumErr += 255 - luminance
Else
sumErr += 255 - sourceImage(i)
End If
Next
' Standardize to a suitable factor, e.g. 1000 lines with medium error
Dim As Double avgErr = sumErr / IMG_SIZE_SQ
Return CInt(avgErr * TUNINGFACTOR)
End Function
Sub EllipseAA(x As Single, y As Single, radiusX As Single, radiusY As Single, _col As ULong, thickness As Single = 1, mode As UByte = 1, pImage As Any Ptr = 0) '...'
Dim As Single dist, db, n, nn, ellR, ellE, ellCA, px, py, px2
If radiusX > radiusY Then
ellE = Sqr(radiusX * radiusX - radiusY * radiusY) / radiusX
Else
ellE = Sqr(radiusY * radiusY - radiusX * radiusX) / radiusY
EndIf
ellE *= ellE
If mode = 1 Then
For n = 0.5 To radiusX
For nn = 0.5 To radiusY
dist = Sqr(n * n + nn * nn)
If radiusX > radiusY Then
If n Then
ellCA = n / dist
ellR = Sqr(radiusY * radiusY / (1 - ellE * ellCA * ellCA))
Else
ellR = radiusY
End If
Else
If nn Then
ellCA = nn / dist
ellR = Sqr(radiusX * radiusX / (1 - ellE * ellCA * ellCA))
Else
ellR = radiusX
End If
End If
If dist <= ellR And dist > ellR - 1 Then 'outer border aa
db = Abs(ellR - 1 - dist)
px = x + n : py = y + nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x + n : py = y - nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
ElseIf dist <= ellR - thickness And dist > ellR - thickness - 1 Then 'inner border aa
db = Abs(ellR - thickness - dist)
px = x + n : py = y + nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x + n : py = y - nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
ElseIf dist <= ellR - 1 And dist > ellR - thickness Then 'fill
py = y + nn
px = x + n
px2 = x - n
PSet pImage, (px, py), _col 'right bottom section
PSet pImage, (px2, py), _col 'left bottom section
py = y - nn
PSet pImage, (px, py), _col 'right top section
PSet pImage, (px2, py), _col 'left top section
End If
Next
Next
Else
For n = 0.5 To radiusX
For nn = 0.5 To radiusY
dist = Sqr(n * n + nn * nn)
If radiusX > radiusY Then
If n Then
ellCA = n / dist
ellR = Sqr(radiusY * radiusY / (1 - ellE * ellCA * ellCA))
Else
ellR = radiusY
End If
Else
If nn Then
ellCA = nn / dist
ellR = Sqr(radiusX * radiusX / (1 - ellE * ellCA * ellCA))
Else
ellR = radiusX
End If
End If
If dist <= ellR And dist > ellR - 1 Then
db = 1 - (ellR - dist)
px = x + n : py = y + nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x + n : py = y - nn
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
px = x - n
PSet pImage, (px, py), ColBlend(Point (px, py, pImage), _col, db)
ElseIf dist <= ellR - 1 Then
py = y + nn
px = x + n
px2 = x - n
PSet pImage, (px, py), _col
PSet pImage, (px2, py), _col
py = y - nn
PSet pImage, (px, py), _col
PSet pImage, (px2, py), _col
EndIf
Next
Next
EndIf
End Sub
Function LoadImage(filename As String) As Byte '...'
Dim As Long imgWidth, imgHeight, sx, sy, ex, ey, x, y
GetImgDim(filename, imgWidth, imgHeight)
If imgWidth = 0 Or imgHeight = 0 Then '...'
Print !"ERROR - could not load image file: " & filename
Return 0
End If
If imgWidth = imgHeight Then '...'
sx = 0
sy = 0
IMG_SIZE = imgWidth
ElseIf imgWidth > imgHeight Then
sx = (imgWidth - imgHeight) \ 2
sy = 0
IMG_SIZE = imgHeight
Else '...'
sx = 0
sy = (imgHeight - imgWidth) \ 2
IMG_SIZE = imgWidth
End If
IMG_SIZE_SQ = IMG_SIZE * IMG_SIZE
Dim As Double avgPinSpacing = (2 * PI * (IMG_SIZE / 2)) / PINS
MIN_DISTANCE = Int((MINLENGTH / avgPinSpacing) + 0.5)
'MIN_DISTANCE = Int(IMG_SIZE / PINS * 2)
ReDim As UByte sourceImage(IMG_SIZE_SQ - 1)
ReDim As Integer errorImage(IMG_SIZE_SQ - 1)
ReDim As ULong colorImage(IMG_SIZE_SQ - 1)
ReDim As Integer line_cache_x(PINS * PINS - 1, 0 To IMG_SIZE * 2)
ReDim As Integer line_cache_y(PINS * PINS - 1, 0 To IMG_SIZE * 2)
ScreenRes IMG_SIZE, IMG_SIZE, 32, , GFX_ALPHA_PRIMITIVES
CenterFBWin(IMG_SIZE, IMG_SIZE)
Color 0, IIf(bINVERS, &hFF000000 Or ((&hFFFFFF And BGCOLOR) Xor &hFFFFFF), BGCOLOR)
Cls
Dim As Any Ptr img = ImageCreate(imgWidth, imgHeight)
BLoad(filename, img)
Dim As _Color c
Dim As UByte r
Dim As ULong o
For y = 0 To IMG_SIZE - 1
o = y + sy
For x = 0 To IMG_SIZE - 1
c.argb = Point(x + sx, o, img)
If c.r <> c.g OrElse c.g <> c.b Then 'convert pixel to grey if not
r = CUByte((c.r * 213 + c.g * 715 + c.b * 72) / 1000)
Else
r = c.r
End If
sourceImage(y * IMG_SIZE + x) = IIf(bINVERS, 255 - r, r)
colorImage(y * IMG_SIZE + x) = c.argb
Next
Next
ImageDestroy(img)
MAX_LINES = EstimateMaxLines()
Return 1
End Function
Sub calculatePinCoords() '...'
Dim As Double cx = IMG_SIZE / 2, angle
Dim radius As Double = cx - 1
For i As Integer = 0 To PINS - 1
angle = 2 * PI * i / PINS
pin_coords(i).x = Int(cx + radius * Cos(angle))
pin_coords(i).y = Int(cx + radius * Sin(angle))
Next
End Sub
Function linspaceInt(startv As Integer , endv As Integer , count As Integer , result() As Integer ) As Integer '...'
If count < 2 Then Return 0
Dim As Double stepv = (endv - startv) / (count - 1)
For i As Integer = 0 To count - 1
result(i) = Int(startv + stepv * i)
Next
Return count
End Function
Sub precalculateLines() '...'
Dim As Integer i, j, k, x0, y0, x1, y1, dx, dy, steps, used, idx1, idx2, imax = IMG_SIZE * 2
Dim As Double dist
For i = 0 To PINS - 1
For j = i + MIN_DISTANCE To PINS - 1
x0 = pin_coords(i).x
y0 = pin_coords(i).y
x1 = pin_coords(j).x
y1 = pin_coords(j).y
dx = x1 - x0
dy = y1 - y0
dist = Sqr(dx * dx + dy * dy)
steps = Int(dist)
If steps > imax Then steps = imax
Dim tempX(0 To imax) As Integer
Dim tempY(0 To imax) As Integer
used = linspaceInt(x0, x1, steps, tempX())
linspaceInt(y0, y1, steps, tempY())
idx1 = j * PINS + i
idx2 = i * PINS + j
For k = 0 To used - 1
line_cache_x(idx1, k) = tempX(k)
line_cache_y(idx1, k) = tempY(k)
line_cache_x(idx2, k) = tempX(k)
line_cache_y(idx2, k) = tempY(k)
Next
line_cache_len(idx1) = used
line_cache_len(idx2) = used
Next
Next
End Sub
Function contains(arr() As Integer, _val As Integer) As Byte '...'
For i As Integer = LBound(arr) To UBound(arr)
If arr(i) = _val Then Return -1
Next
Return 0
End Function
Function GetLineShadeByImage(idx As Integer) As ULong '...'
Dim As Integer sum = 0, x, y
For i As Integer = 0 To line_cache_len(idx) - 1
x = line_cache_x(idx, i)
y = line_cache_y(idx, i)
sum += sourceImage(y * IMG_SIZE + x)
Next
Dim As Integer avg = sum \ line_cache_len(idx)
Return RGBA(avg, avg, avg, 0)
End Function
Function GetSepiaShadeByImage(idx As Integer) As ULong '...'
Dim As Integer rTotal = 0, gTotal = 0, bTotal = 0
Dim As Integer x, y, gray, r, g, b
Dim As Integer count = 0
For i As Integer = 0 To line_cache_len(idx) - 1
x = line_cache_x(idx, i)
y = line_cache_y(idx, i)
gray = sourceImage(y * IMG_SIZE + x)
r = gray * 0.393 + gray * 0.769 + gray * 0.189
g = gray * 0.349 + gray * 0.686 + gray * 0.168
b = gray * 0.272 + gray * 0.534 + gray * 0.131
r = IIf(r > 255, 255, r)
g = IIf(g > 255, 255, g)
b = IIf(b > 255, 255, b)
rTotal += r
gTotal += g
bTotal += b
count += 1
Next
If count = 0 Then Return RGBA(112, 66, 20, 0) ' Fallback to standard Sepia
Return RGBA(rTotal \ count, gTotal \ count, bTotal \ count, 0)
End Function
Function GetSepiaShade(idx As Integer) As ULong
Dim As Integer sum = 0, x, y
For i As Integer = 0 To line_cache_len(idx) - 1
x = line_cache_x(idx, i)
y = line_cache_y(idx, i)
sum += sourceImage(y * IMG_SIZE + x)
Next
Dim As Double gray = sum / line_cache_len(idx)
Dim As Short r = gray + 40 'gray 'gray + 40
Dim As Short g = gray * 0.6 + 30 'gray * 0.75 'gray * 0.6 + 30
Dim As Short b = gray * 0.3 'gray * 0.4 'gray * 0.3
r = IIf(r > 255, 255, r)
g = IIf(g > 255, 255, g)
b = IIf(b > 255, 255, b)
Return RGBA(r, g, b, 0)
End Function
Function Clamp(value As Double, minVal As UByte = 0, maxVal As UByte = 255) As Double '...'
If value < minVal Then Return minVal
If value > maxVal Then Return maxVal
Return value
End Function
Function AdjustContrast(r As Long, g As Long, b As Long) As ULong '...'
Dim As UByte nr = Clamp(128 + (r - 128) * CONTRASTFACTOR)
Dim As UByte ng = Clamp(128 + (g - 128) * CONTRASTFACTOR)
Dim As UByte nb = Clamp(128 + (b - 128) * CONTRASTFACTOR)
Return RGBA(nr, ng, nb, 0)
End Function
Function GetAverageColor(idx As Integer) As ULong '...'
Dim As Long rSum = 0, gSum = 0, bSum = 0, count = 0
Dim As Integer x, y
Dim As _Color c
For i As Integer = 0 To line_cache_len(idx) - 1
x = line_cache_x(idx, i)
y = line_cache_y(idx, i)
c.argb = colorImage(y * IMG_SIZE + x)
rSum += c.r
gSum += c.g
bSum += c.b
count += 1
Next
If count = 0 Then Return &h00000000
Return AdjustContrast(rSum \ count, gSum \ count, bSum \ count)
End Function
Function GetAverageColorArea(cx As Integer , cy As Integer , size As UByte = 2) As ULong 'size 1 = 3x3, 2 = 5x5 '...'
Dim As Integer rSum = 0, gSum = 0, bSum = 0, count = 0
Dim As Integer x, y
Dim As _Color c
For y = cy - size To cy + size
For x = cx - size To cx + size
If x >= 0 And y >= 0 And x < IMG_SIZE And y < IMG_SIZE Then
c.argb = colorImage(y * IMG_SIZE + x)
rSum += c.r
gSum += c.g
bSum += c.b
count += 1
End If
Next
Next
If count = 0 Then Return &h00000000
Return RGBA(rSum \ count, gSum \ count, bSum \ count, ALPHA_CHANNEL)
End Function
Sub DrawColoredLineSegments(x1 As Long, y1 As Long, x2 As Long, y2 As Long) '...'
Dim As Double dx = (x2 - x1) / SEGMENTS
Dim As Double dy = (y2 - y1) / SEGMENTS
Dim As Integer i
Dim As Double sx, sy, ex, ey
Dim As _Color c
Dim As Integer cx, cy, colorVal
For i = 0 To SEGMENTS - 1
sx = x1 + i * dx
sy = y1 + i * dy
ex = x1 + (i + 1) * dx
ey = y1 + (i + 1) * dy
' Koordinaten für Farbprobe
cx = Int((sx + ex) / 2)
cy = Int((sy + ey) / 2)
If cx >= 0 And cy >= 0 And cx < IMG_SIZE And cy < IMG_SIZE Then
'c.argb = colorImage(cy * IMG_SIZE + cx)
'colorVal = RGBA(c.r, c.g, c.b, ALPHA_CHANNEL)
colorVal = GetAverageColorArea(cx, cy, 1)
If bAA Then
DrawLineAAWu(sx, sy, ex, ey, colorVal)
Else
Line (sx, sy) - (ex, ey), colorVal
End If
End If
Next
End Sub
Sub calculateLines(iLineColor As ULong = 0)
Dim As Integer i, j, k, current_pin, last_pins(19), line_sequence(0 To MAX_LINES - 1), _step, best_err, best_pin, best_idx, offset, test_pin, idx, sum, x, y
For i = 0 To IMG_SIZE_SQ - 1
errorImage(i) = 255 - sourceImage(i)
Next
current_pin = 0
For i = 0 To 19
last_pins(i) = -1
Next
If bAUTOSEGMENTS Then SEGMENTS = IMG_SIZE \ 22
iDrawn = 0
For _step = 0 To MAX_LINES - 1
best_err = -1
best_pin = -1
best_idx = -1
For offset = MIN_DISTANCE To PINS - MIN_DISTANCE
test_pin = (current_pin + offset) Mod PINS
If contains(last_pins(), test_pin) Then Continue For
'Dim As Integer dist = Abs(test_pin - current_pin)
'If dist > PINS / 2 Then dist = PINS - dist ' shortest arc on circle
'If dist < MIN_DISTANCE Then Continue For
idx = test_pin * PINS + current_pin
sum = 0
For j = 0 To line_cache_len(idx) - 1
x = line_cache_x(idx, j)
y = line_cache_y(idx, j)
sum += errorImage(y * IMG_SIZE + x)
Next
If sum > best_err Then
best_err = sum
best_pin = test_pin
best_idx = idx
End If
Next
If best_err < 1000 Then 'No more significant error. Abort step
Exit For
End If
If best_pin = -1 Then Exit For
line_sequence(_step) = best_pin
If SEGMENTS > 1 And bCOLOR Then
DrawColoredLineSegments(pin_coords(current_pin).x, pin_coords(current_pin).y, pin_coords(best_pin).x, pin_coords(best_pin).y)
Else
iLineColor = IIf(bINVERS, iLineColor Xor &h00FFFFFF, iLineColor)
If bAA Then
DrawLineAAWu(pin_coords(current_pin).x, pin_coords(current_pin).y, pin_coords(best_pin).x, pin_coords(best_pin).y, ALPHA_CHANNEL Shl 24 Or IIf(bCOLOR, GetAverageColor(best_idx), IIf(bSEPIA, GetSepiaShade(_step), iLineColor)))
Else
Line (pin_coords(current_pin).x, pin_coords(current_pin).y) - (pin_coords(best_pin).x, pin_coords(best_pin).y), ALPHA_CHANNEL Shl 24 Or IIf(bCOLOR, GetAverageColor(best_idx), IIf(bSEPIA, GetSepiaShade(_step), iLineColor))
End If
EndIf
' error update
For j = 0 To line_cache_len(best_idx) - 1
x = line_cache_x(best_idx, j)
y = line_cache_y(best_idx, j)
errorImage(y * IMG_SIZE + x) -= LINE_WEIGHT
Next
For k = 0 To 18
last_pins(k) = last_pins(k + 1)
Next
last_pins(19) = best_pin
current_pin = best_pin
iDrawn += 1
Next
End Sub
'If LoadImage(ExePath & "\salvador-dali 800x800.bmp") = 0 Then End
If LoadImage(ExePath & "\3939159_954x682.bmp") = 0 Then End
calculatePinCoords()
precalculateLines()
calculateLines()
If bBORDER Then EllipseAA(IMG_SIZE \ 2, IMG_SIZE \ 2, IMG_SIZE \ 2 + 1, IMG_SIZE \ 2 + 1, BORDERCLR, BORDERSIZE)
If bSAVERESULT Then
Dim As Any Ptr img = ImageCreate(IMG_SIZE, IMG_SIZE)
Get (0, 0) - (IMG_SIZE - 1, IMG_SIZE - 1), img
BSave(FILENAME, img)
ImageDestroy(img)
EndIf
Sleep
Result example greyscale:
Color:
Color with segments:
GDI+ version can be found on my 1Drv!
Download: StringArtGenerator
