09-19-2024, 08:51 PM
This uses SVG format to draw rounded rectangles.
Code: (Select All)
'Draw rounded rectangles using SVG format
'by James D. Jarvis, use as you wish
Screen _NewImage(800, 500, 32)
_Title "Press any key to draw a new set of rectangles or Q to quit"
Randomize Timer
Dim si As _Unsigned Long
Do
'refresh screen
'define the svg description of 10 rounded rectangles
Cls , _RGB32(100 + Int(Rnd * 150), 100 + Int(Rnd * 150), 100 + Int(Rnd * 150))
ss$ = ""
CX = 100: CY = 100: cRAD = 50
For RR = 1 To 10
xx = Int(Rnd * (_Width * .75)): yy = Int(Rnd * (_Height * .75))
cRAD = Int(3 + Rnd * 12)
WW = Int(30 + Rnd * 300): HH = Int(30 + Rnd * 300)
ss$ = ss$ + doRrect$(xx, yy, cRAD, cRAD, WW, HH, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), Int(1 + Rnd * 25))
Next RR
simg$ = "<svg width='" + _Trim$(Str$(_Width)) + "' height='" + _Trim$(Str$(_Height)) + "'>" + ss$ + " </svg>"
si = _LoadImage(simg$, 32, "memory") 'load the SVG image
_PutImage (0, 0), si 'display the SVG image
_FreeImage si
Do
kk$ = InKey$
Loop Until kk$ <> ""
Loop Until UCase$(kk$) = "Q"
System
Function doRrect$ (x, y, rx, ry, w, h, sk As _Unsigned Long, fk As _Unsigned Long, swid)
'returns the SVG description of a rounded rectangle
'x,y are coordinates of rounded rectabgle on the screen
'rx,ry are the radius of the rectangle corners
'h,y are height and width of the rectangle
'sk is the _rgb32 stroke color
'fk is the _rgb32 fill color
'swid is the stroke width of the rectangle
doRrect$ = " <rect x='" + _Trim$(Str$(x)) + "' y='" + _Trim$(Str$(y)) + "' rx='" + _Trim$(Str$(rx)) + "' ry='" + _Trim$(Str$(ry)) + "' width='" + _Trim$(Str$(h)) + "' height='" + _Trim$(Str$(w)) + "' stroke='" + _Trim$(packcolorN$(sk)) + "' fill='" + _Trim$(packcolorN$(fk)) + "' stroke-width='" + _Trim$(Str$(swid)) + "'/>"
End Function
Function packcolorN$ (klr As _Unsigned Long)
'convert an unsigned long color value into a hexidecimal string # that will be used in an SVG
Dim As _Unsigned Long rk, gk, bk
'get the color channels of the unsinged long color
rk = _Red32(klr)
gk = _Green32(klr)
bk = _Blue32(klr)
'convert those channel values into hexidecimal
If rk < 16 Then
r$ = "0" + Hex$(rk) 'put in a padded hexidcimal value
Else
r$ = Hex$(rk) 'put in a 2 digit hexidecimal value
End If
If gk < 16 Then
g$ = "0" + Hex$(gk) 'put in a padded hexidcimal value
Else
g$ = Hex$(gk) 'put in a 2 digit hexidecimal value
End If
If bk < 16 Then
b$ = "0" + Hex$(bk) 'put in a padded hexidcimal value
Else
b$ = Hex$(bk) 'put in a 2 digit hexidecimal value
End If
packcolorN$ = "#" + r$ + g$ + b$
End Function