rounded rectangles and buttons

[James D Jarvis]

This little program is a demo for simple  rounded rectangle routines. It'll draw buttons too (but i didn't code them to be clickable here).

Code: (Select All)

'simple rounded rectangles
Screen _NewImage(800, 480, 32)
Dim Shared klr(0 To 255) As _Unsigned Long
buildrefcolors
rbrect 1, 1, 798, 462, 4, 2, klr(4), klr(16) 'the demo screen is in a rounded rectangle
roundrect 20, 20, 100, 50, 12, klr(12)
_PrintString (150, 20), "roundrect  at 20,20  100 wide and 50 high, corner radius 12"

roundrect 20, 100, 100, 50, 200, klr(6)
_PrintString (150, 100), "roundrect  at 20,100  100 wide and 50 high, corner radius 200"
_PrintString (150, 117), "       the radius is trimmed down if is larger than height or width"

rbrect 20, 200, 100, 20, 5, 3, klr(12), klr(22)
_PrintString (150, 200), "round bordered rectangle at 20,200 40 wide adn 20 high, corner radius 5"
_PrintString (150, 217), "border thickness of 3"

rbrect_button 20, 250, 100, 30, 6, 4, klr(11), klr(22), "A Button"
_PrintString (150, 250), "Rounded bordered rectangle as a button image , "
_PrintString (150, 267), "similar to above but text is inserted and centered in sub"
rbrect_button 20, 320, 100, 30, 300, 3, klr(11), klr(22), "Second Btn"
_PrintString (150, 320), "same as above but with over-sized radius to get round sides"

Sub rbrect_button (xx, yy, ww, hh, r, brd, c1, c2, txt$)
    _PrintMode _KeepBackground
    rbrect xx, yy, ww, hh, r, brd, c1, c2
    bpw = _PrintWidth(txt$)
    bph = _FontHeight
    cx = (xx * 2 + ww) / 2
    tx = cx - bpw / 2
    ty = yy + hh / 2 - bph / 2
    _PrintString (tx, ty), txt$
End Sub

Sub rbrect (xx, yy, ww, HH, r, brdt, c1 As _Unsigned Long, c2 As _Unsigned Long)

    roundrect xx, yy, ww, HH, r, c1
    roundrect xx + brdt, yy + brdt, ww - (brdt * 2), HH - (brdt * 2), r - Int(brdt / 2), c2

End Sub
Sub roundrect (xx, yy, ww, HH, r, c As _Unsigned Long)
    dr = r
    If dr > ww / 2 Then dr = ww / 2 - 1
    If dr > HH / 2 Then dr = HH / 2 - 1
    x1 = xx: x2 = xx + ww - 1
    y1 = yy: y2 = yy + HH - 1
     'draw the circles at each corner inside the rectangle coordiates
    CircleFill x1 + dr, y1 + dr, dr, c
    CircleFill x2 - dr, y1 + dr, dr, c
    CircleFill x1 + dr, y2 - dr, dr, c
    CircleFill x2 - dr, y2 - dr, dr, c
    'connect them with properly sized rectangles
    Line (x1 + dr, y1)-(x2 - dr, y2), c, BF
    Line (x1, y1 + dr)-(x2, y2 - dr), c, BF
End Sub

Sub buildrefcolors
    'reference colors
    'very slightly cooled EGA palette
    _Source tiles&
    klr(0) = Point(1, 1)
    'very slightly cooled EGA palette
    klr(1) = _RGB32(0, 0, 170) 'ega_blue
    klr(2) = _RGB32(0, 170, 0) 'ega_green
    klr(3) = _RGB32(0, 170, 170) 'ega_cyan
    klr(4) = _RGB(170, 0, 0) 'ega_red
    klr(5) = _RGB32(170, 0, 170) 'ega_magenta
    klr(6) = _RGB32(170, 85, 0) 'ega_brown
    klr(7) = _RGB32(170, 170, 170) 'ega_litgray
    klr(8) = _RGB32(85, 85, 85) 'ega_gray
    klr(9) = _RGB32(85, 85, 250) 'ega_ltblue
    klr(10) = _RGB32(85, 250, 85) 'ega_ltgreen
    klr(11) = _RGB32(85, 250, 250) 'ega_ltcyan
    klr(12) = _RGB32(250, 85, 85) 'ega_ltred
    klr(13) = _RGB32(250, 85, 250) 'ega_ltmagenta
    klr(14) = _RGB32(250, 250, 85) 'ega_yellow
    klr(15) = _RGB(250, 250, 250) 'ega_white
    'filling the rest with greyscale
    For c = 16 To 255
        klr(c) = _RGB32(c, c, c)
    Next c
End Sub


Sub CircleFill (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend

End Sub

[bplus]

Ha! Great minds think alike! I posted similar, in fact, this post had me go back and check if mine did width and height of rounded button / frame, it did but I posted older code for the demo which had to be replaced. We did approach the building of the shape differently.

https://qb64phoenix.com/forum/showthread...18#pid1218

[James D Jarvis]

Ha! Great minds think alike! I posted similar, in fact, this post had me go back and check if mine did width and height of rounded button / frame, it did but I posted older code for the demo which had to be replaced. We did approach the building of the shape differently.

https://qb64phoenix.com/forum/showthread...18#pid1218

I spotted yours just before I posted mine and almost didn't post mine. But different enough so posted it.

I had a devil of a time getting the rounded rectangles to work until I realized it was safer and easier to draw from a defined top left corner and then build out with width and height that way x2 is always right of x1 and  y2 is always down from y1.

[Pete]

Hi Jimmy D., I love it! I'm basically a SCREEN ZERO HERO from the past, but it's always great to see graphics alternatives.

I hope you don't mind, but I included your code here with some minor tweaking to the text lettering, to provide a transparent background, and to give the window a title. You are welcome to use the tweaks and if you like the results and want to edit your version, feel free to do so. If you don't, just yell back at me: Stay off my lawn! (Inside joke).

Code: (Select All)

_TITLE "Simple Rounded Rectangles by James D. Jarvis."

'simple rounded rectangles
SCREEN _NEWIMAGE(800, 480, 32)
DIM SHARED klr(0 TO 255) AS _UNSIGNED LONG

_PRINTMODE _KEEPBACKGROUND ' These two statements make your text present with a transparent background.
COLOR _RGB32(255, 255, 255)

buildrefcolors
rbrect 1, 1, 798, 462, 4, 2, klr(4), klr(16) 'the demo screen is in a rounded rectangle
roundrect 20, 20, 100, 50, 12, klr(12)
_PRINTSTRING (150, 30), "Roundrect at 20, 20.  100 wide and 50 high, corner radius 12"

roundrect 20, 100, 100, 50, 200, klr(6)
_PRINTSTRING (150, 100), "Roundrect  at 20, 100.  100 wide and 50 high, corner radius 200"
_PRINTSTRING (150, 117), "the radius is trimmed down if is larger than height or width"

rbrect 20, 200, 100, 20, 5, 3, klr(12), klr(22)
_PRINTSTRING (150, 200), "Round bordered rectangle at 20,200 40 wide adn 20 high, corner radius 5"
_PRINTSTRING (150, 217), "border thickness of 3."

rbrect_button 20, 250, 100, 30, 6, 4, klr(11), klr(22), "A Button"
_PRINTSTRING (150, 250), "Rounded bordered rectangle as button image, similar to above but text inserted"
_PRINTSTRING (150, 267), "and centered in sub similar to above but text is inserted and centered in sub."
rbrect_button 20, 320, 100, 30, 300, 3, klr(11), klr(22), "Second Btn"
_PRINTSTRING (150, 320), "Same as above but with over-sized radius to get round sides."

SUB rbrect_button (xx, yy, ww, hh, r, brd, c1, c2, txt$)
    _PRINTMODE _KEEPBACKGROUND
    rbrect xx, yy, ww, hh, r, brd, c1, c2
    bpw = _PRINTWIDTH(txt$)
    bph = _FONTHEIGHT
    cx = (xx * 2 + ww) / 2
    tx = cx - bpw / 2
    ty = yy + hh / 2 - bph / 2
    _PRINTSTRING (tx, ty), txt$
END SUB

SUB rbrect (xx, yy, ww, HH, r, brdt, c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG)

    roundrect xx, yy, ww, HH, r, c1
    roundrect xx + brdt, yy + brdt, ww - (brdt * 2), HH - (brdt * 2), r - INT(brdt / 2), c2

END SUB
SUB roundrect (xx, yy, ww, HH, r, c AS _UNSIGNED LONG)
    dr = r
    IF dr > ww / 2 THEN dr = ww / 2 - 1
    IF dr > HH / 2 THEN dr = HH / 2 - 1
    x1 = xx: x2 = xx + ww - 1
    y1 = yy: y2 = yy + HH - 1
    'draw the circles at each corner inside the rectangle coordiates
    CircleFill x1 + dr, y1 + dr, dr, c
    CircleFill x2 - dr, y1 + dr, dr, c
    CircleFill x1 + dr, y2 - dr, dr, c
    CircleFill x2 - dr, y2 - dr, dr, c
    'connect them with properly sized rectangles
    LINE (x1 + dr, y1)-(x2 - dr, y2), c, BF
    LINE (x1, y1 + dr)-(x2, y2 - dr), c, BF
END SUB

SUB buildrefcolors
    'reference colors
    'very slightly cooled EGA palette
    _SOURCE tiles&
    klr(0) = POINT(1, 1)
    'very slightly cooled EGA palette
    klr(1) = _RGB32(0, 0, 170) 'ega_blue
    klr(2) = _RGB32(0, 170, 0) 'ega_green
    klr(3) = _RGB32(0, 170, 170) 'ega_cyan
    klr(4) = _RGB(170, 0, 0) 'ega_red
    klr(5) = _RGB32(170, 0, 170) 'ega_magenta
    klr(6) = _RGB32(170, 85, 0) 'ega_brown
    klr(7) = _RGB32(170, 170, 170) 'ega_litgray
    klr(8) = _RGB32(85, 85, 85) 'ega_gray
    klr(9) = _RGB32(85, 85, 250) 'ega_ltblue
    klr(10) = _RGB32(85, 250, 85) 'ega_ltgreen
    klr(11) = _RGB32(85, 250, 250) 'ega_ltcyan
    klr(12) = _RGB32(250, 85, 85) 'ega_ltred
    klr(13) = _RGB32(250, 85, 250) 'ega_ltmagenta
    klr(14) = _RGB32(250, 250, 85) 'ega_yellow
    klr(15) = _RGB(250, 250, 250) 'ega_white
    'filling the rest with greyscale
    FOR c = 16 TO 255
        klr(c) = _RGB32(c, c, c)
    NEXT c
END SUB


SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
    DIM Radius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), C, BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND

END SUB

Pete

[James D Jarvis]

I knew somebody would catch that. It's here to share so all good.

[bplus]

Now if we use a larger rounded button to use to frame a screen, we would need something to handle multiple lines of text for like a mini-screen, say for a menu. That might be easier to do with the x, y for the top, left corner.