+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: rounded rectangles and buttons (/showthread.php?tid=276)
rounded rectangles and buttons - James D Jarvis - 04-29-2022
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 SubRE: rounded rectangles and buttons - bplus - 04-29-2022
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://staging.qb64phoenix.com/showthread.php?tid=272&pid=1218#pid1218
RE: rounded rectangles and buttons - James D Jarvis - 04-29-2022
(04-29-2022, 10:09 PM)bplus Wrote: 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://staging.qb64phoenix.com/showthread.php?tid=272&pid=1218#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.
RE: rounded rectangles and buttons - Pete - 04-29-2022
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 SUBPete
RE: rounded rectangles and buttons - James D Jarvis - 04-30-2022
I knew somebody would catch that. It's here to share so all good.
RE: rounded rectangles and buttons - bplus - 04-30-2022
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.