Posts: 3,446
Threads: 376
Joined: Apr 2022
Reputation:
345
10-14-2023, 01:45 AM
(This post was last modified: 09-15-2024, 08:16 AM by SMcNeill.)
Code: (Select All)
Option _Explicit
Screen _NewImage(640, 480, 32)
$Color:32
RoundRect 100, 100, 200, 200, 15, Red
RoundRectFill 200, 210, 300, 250, 5, Green
thickCircle 300, 325, 50, 4, Blue
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
So, while I was searching my hard drives for little routines and utilities to add to my new little Github Toolbox project, I came across these old routines -- RoundRectFill and thickCircle. I don't know who the original author of these were; I don't think I wrote them, but the drive they were on was probably 5 to 10 years old and dated all the way back to the days of Galleon's Forums (.net?), and back when we were all chatting and talking over on the freenode IRC chat channels. (MY original SBot which ran via freenode was in the same folders, which is what helps me date how old these things are! LOL!)
My best guess is STxATxIC or perhaps vince helped create these originally. If anyone knows for certain who the original author of RoundRectFill and thickCircle are, let me know and I'll be certain to add their names to the routines to give them credit for their work.
(If you notice, I didn't list RoundRect as being unknown. That's simple -- I wrote it this evening to go with the filled version. If there was ever an original RoundRect routine somewhere, I didn't save it, so the one here is one I derived myself. It's no mystery code!  )
Anyways, I thought I'd share these here to see if anyone knows for certain who the original authors were, before just tossing them all slappy-happy into my toolbox. Kindly speak up if they were yours. Heck, they might've even been mine -- though it's been so long, I certainly don't remember them! LOL! Solve the mystery, if you have information on "Where the heck did those come from?"
Posts: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
10-14-2023, 07:25 AM
(This post was last modified: 10-14-2023, 07:53 AM by bplus.)
(10-14-2023, 01:45 AM)SMcNeill Wrote: Code: (Select All)
Option _Explicit
Screen _NewImage(640, 480, 32)
$Color:32
RoundRect 100, 100, 200, 200, 15, Red
RoundRectFill 200, 210, 300, 250, 5, Green
thickCircle 300, 325, 50, 4, Blue
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)-(x1, y1 - r), 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
So, while I was searching my hard drives for little routines and utilities to add to my new little Github Toolbox project, I came across these old routines -- RoundRectFill and thickCircle. I don't know who the original author of these were; I don't think I wrote them, but the drive they were on was probably 5 to 10 years old and dated all the way back to the days of Galleon's Forums (.net?), and back when we were all chatting and talking over on the freenode IRC chat channels. (MY original SBot which ran via freenode was in the same folders, which is what helps me date how old these things are! LOL!)
My best guess is STxATxIC or perhaps vince helped create these originally. If anyone knows for certain who the original author of RoundRectFill and thickCircle are, let me know and I'll be certain to add their names to the routines to give them credit for their work.
(If you notice, I didn't list RoundRect as being unknown. That's simple -- I wrote it this evening to go with the filled version. If there was ever an original RoundRect routine somewhere, I didn't save it, so the one here is one I derived myself. It's no mystery code! )
Anyways, I thought I'd share these here to see if anyone knows for certain who the original authors were, before just tossing them all slappy-happy into my toolbox. Kindly speak up if they were yours. Heck, they might've even been mine -- though it's been so long, I certainly don't remember them! LOL! Solve the mystery, if you have information on "Where the heck did those come from?"
Well I worked on both these drawing problems and posted results in my own Toolbox Thread stuff at QB64.org and here in drawing tools or in Programs Board and probably at QB64.net where someone gave me a filled triangle from MapTriangle and you Steve improved upon over years. I started with rounded squares called Squircles (and that was a name I stole from Math YouTube video on slightly different idea doing corners with math functions) and called thick circles, rings, and thick arcs fat or thick arcs same with lines. But if code is from my stuff feel free to use it, I am not going to try and keep track of what people do with code I share. Great minds think alike so other people will likely see their work in other peoples posts. I know Fellippe did stuff with rounded corners and thick lines also .P5J some bunch of letters and a 5.
Here is squircle https://qb64phoenix.com/forum/showthread...18#pid1218
If you want to compare what you have with what I did. That thick circle looks new method to me.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 3,446
Threads: 376
Joined: Apr 2022
Reputation:
345
Updated the Rounded.Rectangle.Fill routine:
Code: (Select All)
Screen _NewImage(800, 600, 32)
$Resize:Stretch
$Color:32
Cls , Blue
For i = 1 To 10
Draw.Rect.Rounded.Fill 400, 100, 500, 200, 10, _RGBA32(200, 200, 200, 50)
Next
Sub Draw.Rect.Rounded.Fill (x As Long, y As Long, x1 As Long, y1 As Long, radius As Long, c As _Unsigned Long)
Dim As Long tmp, w, h, r, yy, inset, dy, dx
Dim As Double rr
' Normalize coordinates
If x1 < x Then Swap x1, x
If y1 < y Then Swap y1, y
w = x1 - x: h = y1 - y: If w <= 0 Or h <= 0 Then Exit Sub
' Clamp radius to fit
r = radius: If r < 0 Then r = 0
tmp = w: If h < tmp Then tmp = h
If r * 2 > tmp Then r = tmp \ 2
If r = 0 Then Line (x, y)-(x1, y1), c, BF: Exit Sub
rr = r * r
For yy = y To y1
inset = 0
If yy < y + r Then ' Top rounded region
dy = (y + r) - yy ' 0..r
dx = Int(Sqr(rr - dy * dy))
inset = r - dx ' shrink corners, keep middle wide
ElseIf yy > y1 - r Then ' Bottom rounded region
dy = yy - (y1 - r) ' 0..r
dx = Int(Sqr(rr - dy * dy))
inset = r - dx
End If
If x + inset <= x1 - inset Then Line (x + inset, yy)-(x1 - inset, yy), c
Next yy
End Sub
This works nicely with alpha blending, where the other had issues with overlapping scanlines.
Posts: 316
Threads: 16
Joined: Apr 2022
Reputation:
43
I came up with one that I call Balloon_Box, which uses the fill circle routine on the corners.
Code: (Select All) $COLOR:32
TYPE V2
x AS INTEGER
y AS INTEGER
END TYPE
TYPE region
ul AS V2
lr AS V2
END TYPE
SCREEN _NEWIMAGE(1024, 512, 32)
DO: LOOP UNTIL _SCREENEXISTS
DIM AS region ulrg, urrg, llrg, lrrg
ulrg.ul.x = 0: ulrg.ul.y = 0: ulrg.lr.x = _WIDTH / 2 - 1: ulrg.lr.y = _HEIGHT / 2 - 1
urrg.ul.x = _WIDTH / 2: urrg.ul.y = 0: urrg.lr.x = _WIDTH - 1: urrg.lr.y = _HEIGHT / 2 - 1
llrg.ul.x = 0: llrg.ul.y = _HEIGHT / 2: llrg.lr.x = _WIDTH / 2 - 1: llrg.lr.y = _HEIGHT - 1
lrrg.ul.x = _WIDTH / 2: lrrg.ul.y = _HEIGHT / 2: lrrg.lr.x = _WIDTH - 1: lrrg.lr.y = _HEIGHT - 1
DO
CLS
BalloonRegion ulrg, Green, Blue
BalloonRegion urrg, Black, Cyan
BalloonRegion llrg, Black, White
BalloonRegion lrrg, Blue, Green
WHILE _MOUSEINPUT: WEND
'BalloonBox _MOUSEX, _MOUSEY, Green, Red, 0, 0
BalloonBox 100, 100, Green, Red, _MOUSEX - 50, _MOUSEY - 50
_LIMIT 30
_DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
SUB BalloonRegion (r AS region, bk AS _UNSIGNED LONG, vg AS _UNSIGNED LONG)
BalloonBox r.lr.x - r.ul.x, r.lr.y - r.ul.y, bk, vg, r.ul.x, r.ul.y
END SUB 'BalloonRegion
SUB BalloonBox (wd AS INTEGER, ht AS INTEGER, bk AS _UNSIGNED LONG, vg AS _UNSIGNED LONG, xp AS INTEGER, yp AS INTEGER)
DIM bbox&, pre&
DIM radius%, shrink%, wd1%, ht1%
IF wd < 1 OR ht < 1 THEN EXIT SUB
radius% = _IIF(wd < ht, wd \ 10, ht \ 10)
shrink% = radius% \ 4
bbox& = _NEWIMAGE(wd, ht, 32) ' balloon
wd1% = _WIDTH(bbox&) - 1: ht1% = _HEIGHT(bbox&) - 1
pre& = _DEST
_DEST bbox&
CLS , &HFFFF00FF ' full magenta masking color
'Draw outer border in border color (vg)
LINE (radius%, 0)-(wd1% - radius%, ht1%), vg, BF ' Tall narrow block
LINE (0, radius%)-(wd1%, ht1% - radius%), vg, BF ' short fat block
FCirc radius%, radius%, radius%, vg ' upper left fillet
FCirc wd1% - radius%, radius%, radius%, vg ' upper right fillet
FCirc radius%, ht1% - radius%, radius%, vg ' lower left fillet
FCirc wd1% - radius%, ht1% - radius%, radius%, vg ' lower right fillet
'draw inner field in background color (bk)
LINE (radius%, shrink%)-(wd1% - radius%, ht1% - shrink%), bk, BF
LINE (shrink%, radius%)-(wd1% - shrink%, ht1% - radius%), bk, BF
FCirc radius%, radius%, radius% - shrink%, bk
FCirc wd1% - radius%, radius%, radius% - shrink%, bk
FCirc radius%, ht1% - radius%, radius% - shrink%, bk
FCirc wd1% - radius%, ht1% - radius%, radius% - shrink%, bk
_CLEARCOLOR &HFFFF00FF
_DEST pre&
_PUTIMAGE (xp, yp), bbox&
_FREEIMAGE bbox&
END SUB 'BallonBox
SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG) 'Steve's circle draw
DIM AS INTEGER R, RError, X, Y
R = ABS(RR) ' radius value along positive x
RError = -R ' opposite side of circle? negative x
X = R ' point along positive x position
Y = 0 ' starting at the equator
IF R = 0 THEN PSET (CX, CY), C: EXIT SUB ' zero radius is point, not circle
LINE (CX - X, CY)-(CX + X, CY), C, BF ' draw equatorial line
WHILE X > Y
RError = RError + Y * 2 + 1
IF RError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
END IF
X = X - 1
RError = RError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF ' draw line north latitudes
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF ' draw line south latitudes
WEND
END SUB 'FCirc
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Posts: 346
Threads: 45
Joined: Jun 2024
Reputation:
32
Original Rounded Rectangle was by Cypherium, used it in the first versions of VQB as my dialog windows to get the MacOS look.
John
Posts: 329
Threads: 22
Joined: Apr 2022
Reputation:
60
here are the vince specials:
Code: (Select All)
defint a-z
screen _newimage(800,600,32)
'line (300,300)-step(320,240), _rgba(200,200,0,100), bf
do
do
mx = _mousex
my = _mousey
loop while _mouseinput
cls
circlef 200,200,100,_rgba(0,255,0,100)
cboxf 300, 300, 320, 240, 10, _rgba(200,200,0,100)
cboxf 300, 300, mx-300, my-300, 50, _rgba(200,100,50,100)
cbox 250, 250, 300, 300, 80, _rgba(200,255,0,100)
_display
_limit 30
loop until _keyhit = 27
sleep
system
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
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
sub circlef (x, y, r, c as _unsigned long)
x0 = r
y0 = 0
e = -r
do while y0 < x0
if e <= 0 then
y0 = y0 + 1
line (x-x0, y+y0)-(x+x0, y+y0), c, bf
line (x-x0, y-y0)-(x+x0, y-y0), c, bf
e = e + 2*y0
else
line (x-y0, y-x0)-(x+y0, y-x0), c, bf
line (x-y0, y+x0)-(x+y0, y+x0), c, bf
x0 = x0 - 1
e = e - 2*x0
end if
loop
line (x-r,y)-(x+r,y),c,bf
end sub
|
