Had a small Polygon drawing SUB handy, thought I'd make a screen saver using it. You can specify the number of sides, radius, angle, border and fill color of polygon. Maybe useful to somebody.
UPDATED: Now draws filled polygons.
- Dav
UPDATED: Now draws filled polygons.
- Dav
Code: (Select All)
'=====================
'PolygonPlayground.bas v2.0
'=====================
'A single SUB that draws a polygon, filled or not..
'Specify number of sides, radius, angle, border and fill color of polygon.
'Put together by Dav, AUG/2024
'This demo shows the SUB in action.
Screen _NewImage(1000, 700, 32)
Randomize Timer
polygons = 200 'number of polgons in playground
Dim polysides(polygons)
Dim polyradius(polygons)
Dim polyclr&(polygons)
Dim polycx(polygons)
Dim polycy(polygons)
'make random polgons specs
For i = 1 To polygons
polysides(i) = 3 + Int(Rnd * 10)
polyradius(i) = 30 + Int(Rnd * 150)
polyclr&(i) = _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255)
'turn some of those no fill (zero value)
If Int(Rnd * 5) = 1 Then polyclr&(i) = 0
polycx(i) = Rnd * _Width
polycy(i) = Rnd * _Height
Next
Do
'spin them all it around
For a = 0 To 359
Cls , _RGB(255, 255, 255)
For i = 1 To polygons
Polygon polysides(i), polycx(i), polycy(i), polyradius(i), a, _RGBA(0, 0, 0, 128), polyclr&(i)
Next
_Display
_Limit 60
If InKey$ <> "" Then Exit Do
Next
Loop
Sub Polygon (sides, cx, cy, radius, angle, borderclr~&, fillclr~&)
'Draws a polygon. Must have at least 3 sides.
'Polygon can be filled or not.
'borderclr~& is the color of the polygon sides.
'if you want a filled polygon, give a fillclr~& color.
'if you want only sides drawn (not filled polygon),
'just use a 0 for the fillclr~& parameter.
If sides < 3 Then sides = 3
rot = _D2R(angle)
x1 = cx + radius * Cos(rot)
y1 = cy + radius * Sin(rot)
'draw sides
For i = 1 To sides
va = rot + 2 * _Pi * i / sides
x2 = cx + radius * Cos(va)
y2 = cy + radius * Sin(va)
Line (x1, y1)-(x2, y2), borderclr~&
x1 = x2: y1 = y2
Next
'fill inside, if not 0 given
If fillclr~& <> 0 Then
ymin = cy - radius
ymax = cy + radius
For y = ymin To ymax
edge = 0
x1 = cx + radius * Cos(rot)
y1 = cy + radius * Sin(rot)
For i = 1 To sides
va = rot + 2 * _Pi * i / sides
x2 = cx + radius * Cos(va)
y2 = cy + radius * Sin(va)
If ((y1 < y And y2 >= y) Or (y2 < y And y1 >= y)) Then
edge = edge + 1
If edge = 1 Then
leftx = x1 + (y - y1) * (x2 - x1) / (y2 - y1)
ElseIf edge = 2 Then
rightx = x1 + (y - y1) * (x2 - x1) / (y2 - y1)
End If
End If
x1 = x2: y1 = y2
Next
If edge = 2 Then Line (leftx, y)-(rightx, y), fillclr~&
Next
End If
End Sub