SUB that draws boxes with rounded corners.

[SMcNeill]

I ran Dav, Steve and my versions they all suck for transparent colors but Steve's looks best.

Mine just had one line of overlap, and that was easily fixed:

Code: (Select All)

Screen _NewImage(640, 480, 32)

$Color:32



For i = 1 To 20 'Fixed for transparent colors

    RoundRectFill 100, 100, 400, 400, 15, &H33AA0000

Next

Sleep

Cls , 0

For i = 1 To 20

    RoundRect 100, 100, 400, 400, 15, &H33AA0000

Next









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 thickCircle (x As Single, y As Single, radius As Single, thickness As Single, colour As _Unsigned Long)

    Dim rp As Single, rm As Single, rp2 As Single, rm2 As Single

    Dim sm As Single, rpi2 As Single, rmi2 As Single, sp As Single

    Dim i As Single



    rp = radius + thickness / 2

    rm = radius - thickness / 2

    rp2 = rp ^ 2

    rm2 = rm ^ 2

    For i = -rp To -rm Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

    For i = -rm To 0 Step .2

        rpi2 = rp2 - i ^ 2

        rmi2 = rm2 - i ^ 2

        sm = Sqr(rmi2)

        sp = Sqr(rpi2)

        Line (x + i, y + sm)-(x + i, y + sp), colour, BF

        Line (x - i, y + sm)-(x - i, y + sp), colour, BF

        Line (x + i, y - sm)-(x + i, y - sp), colour, BF

        Line (x - i, y - sm)-(x - i, y - sp), colour, BF

    Next

    For i = rm To rp Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

End Sub

All of them work just fine, with transparent colors if you follow this simple setup:

1) Make a temp 32-bit screen. Turn blending off on it.
2) Draw your image to that screen. Turn blending on, on that screen.
3) Copy that screen to where you want it to be with _PUTIMAGE.
4) Free the temp image if you don't need to use it anymore.

Not everyone thinks, codes, or needs to worry about writing code that works with transparent images. If you ever run across a routine that does what you need it to do, but falls that *tiny* step short, just follow the process above. Draw to a temp screen with blending off, then put to the main screen with blending on.

It's a much easier process than trying to rework complex math formulas or roll your own from scratch a lot of times.