rounded rectangles and buttons

[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