Excellent @vince
Here is what I have for final(?) 3 tests with transparent colors:
Are we ready for time trials
Here is what I have for final(?) 3 tests with transparent colors:
Code: (Select All)
_Title "Rounded Rectangles: test final(?) 3 versions with transparent colors" 'b+ 2024-09-14 mod Dav's
' adding Steve and vince which put mine to shame :)
Randomize Timer
Screen _NewImage(1000, 700, 32)
_ScreenMove 150, 0
'this demo draws random boxes with round corners...
_Title "Test Dav's with transparent colors, press key for Steve's version"
Do
x1 = Int(Rnd * _Width): x2 = x1 + 120 + Int(Rnd * 100)
y1 = Int(Rnd * _Height): y2 = y1 + 120 + Int(Rnd * 100)
radius = 20 + Int(Rnd * 30)
Rbox x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150), Int(Rnd * 2)
_Limit 30
cntr% = cntr% + 1
If cntr% Mod 50 = 49 Then Cls
Loop Until InKey$ <> ""
Cls
_KeyClear
_Title "Test Steve's with transparent colors, any key to vince test"
Do
x1 = Int(Rnd * _Width): x2 = x1 + 120 + Int(Rnd * 100)
y1 = Int(Rnd * _Height): y2 = y1 + 120 + Int(Rnd * 100)
radius = 20 + Int(Rnd * 30)
If Int(Rnd * 2) Then
RoundRectFill x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150)
Else
RoundRect x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150)
End If
_Limit 30
cntr% = cntr% + 1
If cntr% Mod 50 = 49 Then Cls
Loop Until InKey$ <> ""
Cls
_KeyClear
_Title "Test vince with transparent colors"
Do
x1 = Int(Rnd * _Width): x2 = 120 + Int(Rnd * 100)
y1 = Int(Rnd * _Height): y2 = 120 + Int(Rnd * 100)
radius = 20 + Int(Rnd * 30)
If Int(Rnd * 2) Then
cboxf x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150)
Else
cbox x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150)
End If
_Limit 30
cntr% = cntr% + 1
If cntr% Mod 50 = 49 Then Cls
Loop Until _KeyDown(27)
Sub Rbox (x1, y1, x2, y2, r, clr~&, fill) ' Dav fixed overlapping in fills and finally corners 2024-09-15
' x1/y1, y2/y2 = placement of box
' r = radius of rounded corner
' clr~& = color of box
' fill = 1 for filled, 0 for just an edge
ReDim filled(_Width + x2, _Height + y2) As Integer
If fill = 1 Then
Line (x1 + r + 1, y1)-(x2 - r - 1, y1 + r), clr~&, BF 'top
Line (x1 + r + 1, y2 - r)-(x2 - r - 1, y2), clr~&, BF 'bottom
Line (x1, y1 + r + 1)-(x1 + r, y2 - r - 1), clr~&, BF 'left
Line (x2 - r, y1 + r + 1)-(x2, y2 - r - 1), clr~&, BF 'right
Line (x1 + r + 1, y1 + r + 1)-(x2 - r - 1, y2 - r - 1), clr~&, BF 'middle
Else
Line (x1 + r, y1)-(x2 - r, y1), clr~& 'top
Line (x1 + r, y2)-(x2 - r, y2), clr~& 'bottom
Line (x1, y1 + r)-(x1, y2 - r), clr~& 'left
Line (x2, y1 + r)-(x2, y2 - r), clr~& 'right
End If
'top left corner
For angle = 180 To 270
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'top right corner
For angle = 270 To 360
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom left corner
For angle = 90 To 180
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom right corner
For angle = 0 To 90
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
End Sub
' Steve fix one overlapping set of lines 2024-09-15
Sub RoundRect (x As Single, y As Single, x1 As Single, y1 As Single, r As Single, c As _Unsigned Long)
Dim a As Single, b As Single, e As Single
'Draw the 4 straight lines first
Line (x, y + r)-(x, y1 - r), c
Line (x1, y + r)-(x1, y1 - r), c
Line (x + r, y)-(x1 - r, y), c
Line (x + r, y1)-(x1 - r, y1), c
a = r: b = 0: e = -a
'And then draw the rounded circle portions of the RoundRect
Do While a >= b
PSet (x + r - b, y + r - a), c: PSet (x1 - r + b, y + r - a), c
PSet (x + r - a, y + r - b), c: PSet (x1 - r + a, y + r - b), c
PSet (x + r - b, y1 - r + a), c: PSet (x1 - r + b, y1 - r + a), c
PSet (x + r - a, y1 - r + b), c: PSet (x1 - r + a, y1 - r + b), c
b = b + 1: e = e + b + b
If e > 0 Then a = a - 1: e = e - a - a
Loop
End Sub
Sub RoundRectFill (x As Single, y As Single, x1 As Single, y1 As Single, r As Single, c As _Unsigned Long)
Dim a As Single, b As Single, e As Single
Line (x, y + r + 1)-(x1, y1 - r - 1), c, BF
a = r: b = 0: e = -a
Do While a >= b
Line (x + r - b, y + r - a)-(x1 - r + b, y + r - a), c, BF
Line (x + r - a, y + r - b)-(x1 - r + a, y + r - b), c, BF
Line (x + r - b, y1 - r + a)-(x1 - r + b, y1 - r + a), c, BF
Line (x + r - a, y1 - r + b)-(x1 - r + a, y1 - r + b), c, BF
b = b + 1: e = e + b + b
If e > 0 Then a = a - 1: e = e - a - a
Loop
End Sub
Sub cboxf (x, y, w, h, r, c As _Unsigned Long) ' vince 2024-09-15
x0 = r
y0 = 0
e = -r
Do While y0 < x0
If e <= 0 Then
y0 = y0 + 1
Line (x + r - x0, y + r - y0)-(x + w - r + x0, y + r - y0), c, BF
Line (x + r - x0, y + h - r + y0)-(x + w - r + x0, y + h - r + y0), c, BF
e = e + 2 * y0
Else
Line (x + r - y0, y + r - x0)-(x + w - r + y0, y + r - x0), c, BF
Line (x + r - y0, y + h - r + x0)-(x + w - r + y0, y + h - r + x0), c, BF
x0 = x0 - 1
e = e - 2 * x0
End If
Loop
Line (x, y + r)-Step(w, h - 2 * r), c, BF
End Sub
Sub cbox (x, y, w, h, r, c As _Unsigned Long) ' vince 2024-09-15
x0 = r
y0 = 0
e = -r
Do While y0 < x0
PSet (x + r - x0, y + r - y0), c
PSet (x + w - r + x0, y + r - y0), c
PSet (x + r - x0, y + h - r + y0), c
PSet (x + w - r + x0, y + h - r + y0), c
PSet (x + r - y0, y + r - x0), c
PSet (x + w - r + y0, y + r - x0), c
PSet (x + r - y0, y + h - r + x0), c
PSet (x + w - r + y0, y + h - r + x0), c
If e <= 0 Then
y0 = y0 + 1
e = e + 2 * y0
Else
x0 = x0 - 1
e = e - 2 * x0
End If
Loop
Line (x, y + r + 1)-Step(0, h - 2 * r - 2), c, BF
Line (x + w, y + r + 1)-Step(0, h - 2 * r - 2), c, BF
Line (x + r + 1, y)-Step(w - 2 * r - 2, 0), c, BF
Line (x + r + 1, y + h)-Step(w - 2 * r - 2, 0), c, BF
End SubAre we ready for time trials
b = b + ...