SUB that draws boxes with rounded corners.

[Dav]

is this gonna be another 10 page arms race? let me throw mine in then

Code: (Select All)

sub cboxf (x, y, w, h, r, c as _unsigned long)
    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

Nice one, @vince!  Fast too.  +1 from me,

I like the think border yours can do, Steve. The one pixel edge mine does isn't very useful now that I think of it, ecxect maybe putting a highlight around a filled one.

- Dav

[bplus]

Mine just had one line of overlap,

No the top and bottom edges had tons of overlap:
   

[bplus]

+1 @Vince fills are great but need a submission for jut rounded boxes without fills. I look at vince version and no longer even want to try my own fix (almost)

Dav's fills look good too but I just noticed the rounded corners in the non filled edges have overlap.

Mine still sucks as not fixed yet and Steve's still has overlap on the top and bottom edges but lines to rectanagle at base of rounded edges are fixed = removed.

Code: (Select All)

_Title "Rounded Rectangles: test with transparent colors" 'b+ 2024-09-14 mod Dav's
' adding Steve and my versions for comparison

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 bplus 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
_Title "Test bplus 'Rectircle' with transparent colors, press escape for Steve's version"
Do
    x1 = Int(Rnd * _Width): x2 = 120 + Int(Rnd * 100)
    y1 = Int(Rnd * _Height): y2 = 120 + Int(Rnd * 100)
    radius = 20 + Int(Rnd * 30)
    Rectircle 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 _KeyDown(27)
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 = x1 + 120 + Int(Rnd * 100)
    y1 = Int(Rnd * _Height): y2 = y1 + 120 + Int(Rnd * 100)
    radius = 20 + Int(Rnd * 30)
    cboxf x1, y1, x2, y2, radius, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 150)
    _Limit 30
    cntr% = cntr% + 1
    If cntr% Mod 50 = 49 Then Cls
Loop Until _KeyDown(27)

End


Sub Rbox (x1, y1, x2, y2, r, clr~&, fill)
    ' 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
                End If
            Next
        Else
            x3 = (x1 + r) + r * Cos(_D2R(angle))
            y3 = (y1 + r) + r * Sin(_D2R(angle))
            PSet (x3, y3), clr~&
        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
                End If
            Next
        Else
            x3 = (x2 - r) + r * Cos(_D2R(angle))
            y3 = (y1 + r) + r * Sin(_D2R(angle))
            PSet (x3, y3), clr~&
        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
                End If
            Next
        Else
            x3 = (x1 + r) + r * Cos(_D2R(angle))
            y3 = (y2 - r) + r * Sin(_D2R(angle))
            PSet (x3, y3), clr~&
        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
                End If
            Next
        Else
            x3 = (x2 - r) + r * Cos(_D2R(angle))
            y3 = (y2 - r) + r * Sin(_D2R(angle))
            PSet (x3, y3), clr~&
        End If
    Next

End Sub


'                   OK this name is stupid!!!
' this sub uses Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
Sub Rectircle (cx, cy, w, h, r, c As _Unsigned Long, Fill) 'assume default single
    ' cx, cy is the middle of the Squircle
    ' a square with arc circle corners
    ' w, h = rectangle width and height
    ' r = radius of circular arc (as opposed to elliptical arc
    ' c is color
    'so r needs to be  < .5 * s ie if r = .5 * s then it's just a circle
    'likewise? if r = 0 then just a square
    Dim temp&, xo, yo, p, pd2, p32, xConst, yConst
    Static sd& ' so dont have to free image after each use
    sd& = _Dest ' save dest
    temp& = _NewImage(w + 1, h + 1, 32) ' create a drawing area  side of square
    _Dest temp&
    xo = w / 2: yo = h / 2 ' middles
    p = _Pi: pd2 = p / 2: p32 = p * 3 / 2
    xConst = .5 * (w - 2 * r) ' looks like this is first needed number to get the 4 origins for the arcs from xm y center
    yConst = .5 * (h - 2 * r)
    '4 arcs
    arc xo - xConst, yo - yConst, r, p, p32, c
    arc xo + xConst, yo - yConst, r, p32, 0, c
    arc xo + xConst, yo + yConst, r, 0, pd2, c
    arc xo - xConst, yo + yConst, r, pd2, p, c
    '4 lines
    Line (xo - xConst, yo - yConst - r)-(xo + xConst, yo - yConst - r), c
    Line (xo - xConst, yo + yConst + r)-(xo + xConst, yo + yConst + r), c
    Line (xo - xConst - r, yo - yConst)-(xo - xConst - r, yo + yConst), c
    Line (xo + xConst + r, yo - yConst)-(xo + xConst + r, yo + yConst), c
    If Fill Then Paint (xo, yo), c, c
    _Dest sd&
    _PutImage (cx - xo, cy - yo), temp&, sd&
End Sub

' will Squircle work with simpler arc sub? the angles are pretty well set
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
    Dim al, a
    'x, y origin, r = radius, c = color

    'raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached

    If raStop < raStart Then
        arc x, y, r, raStart, _Pi(2), c
        arc x, y, r, 0, raStop, c
    Else
        ' modified to easier way suggested by Steve
        'Why was the line method not good? I forgot.
        al = _Pi * r * r * (raStop - raStart) / _Pi(2)
        For a = raStart To raStop Step 1 / al
            PSet (x + r * Cos(a), y + r * Sin(a)), c
        Next
    End If
End Sub

Sub arcC (x, y, r, raBegin, raEnd, c As _Unsigned Long) ' updated 2021-09-09
    ' raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached
    'x, y origin, r = radius, c = color

    Dim p, p2 ' update 2021-09-09 save some time by doing _pi function once
    p = _Pi: p2 = p * 2

    Dim raStart, raStop, dStart, dStop, al, a

    ' Last time I tried to use this SUB it hung the program, possible causes:
    ' Make sure raStart and raStop are between 0 and 2pi.
    ' This sub does not have to be recursive, use GOSUB to do drawing to execute arc in one call.

    'make copies before changing
    raStart = raBegin: raStop = raEnd
    While raStart < 0: raStart = raStart + p2: Wend
    While raStart >= p2: raStart = raStart - p2: Wend
    While raStop < 0: raStop = raStop + p2: Wend
    While raStop >= p2: raStop = raStop - p2: Wend

    If raStop < raStart Then
        dStart = raStart: dStop = p2 - .00001
        GoSub drawArc
        dStart = 0: dStop = raStop
        GoSub drawArc
    Else
        dStart = raStart: dStop = raStop
        GoSub drawArc
    End If
    Exit Sub
    drawArc:
    al = p * r * r * (dStop - dStart) / p2
    For a = dStart To dStop Step 1 / al
        PSet (x + r * Cos(a), y + r * Sin(a)), c
    Next
    Return
End Sub

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)
    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

[Dav]

Updated mine to get ride of the edge overlap.  May add thick line edges next time,  I like those thicker edges.  Planning to use this for menus.

- Dav

Code: (Select All)

'========

'RBOX.BAS v1.02

'========

'Draws a box with rounded corners, filled or unfilled.

'Coded by Dav, SEP/2024



Randomize Timer



Screen _NewImage(1000, 700, 32)



' This demo draws random boxes with round corners...



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, _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255), Int(Rnd * 2)

    _Limit 30

Loop Until InKey$ <> ""



End



Sub Rbox (x1, y1, x2, y2, r, clr~&, fill)

    ' 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

[bplus]

Yep! looks good @Dav

[madscijr]

The problem is always finding it when you need it.  There's just soooo much quality stuff by everyone, that it's hard to remember it all, 

This is a case where tying in an ai tool like ChatGPT could come in handy as a search engine for this site (or even on the desktop, as long as it can be limited to a certain folder). Describe what you want, and it'll find it, and even throw in a few suggestions.

[DANILIN]

People! Export it to visual qbjs.org

Run & Share your transparent Spec effects

My Example without transparent



Plus all complete automation of labyrinth

https://qb64phoenix.com/forum/showthread...0#pid28390

[vince]

+1 @Vince fills are great but need a submission for jut rounded boxes without fills.

Code: (Select All)

sub cbox (x, y, w, h, r, c as _unsigned long)
    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 sub

[bplus]

Excellent @vince

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 Sub

Are we ready for time trials

[vince]

Are we ready for time trials

I officially forfeit, so I guess Steve wins again