Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Improved my small Gradient Ball drawing SUB
#1
I use a small gradient ball SUB in various programs.  It had a flaw however - large balls with dark color values would have think back edges.  Made a new version to fix that.  Just thought I'd share it here.  If you have one too, please share it - I'd love to see what other people are using.  And if you see a way to improve mine please post it.  Thanks!

- Dav

Code: (Select All)

'================
'GRADIENTBALL.BAS
'================
'Simple SUB that draw gradient balls.
'Coded by Dav, JULY/2023


dh = _DESKTOPHEIGHT * .85
SCREEN _NEWIMAGE(dh, dh, 32)

DO
    ball RND * dh, RND * dh, RND * 500 + 25, RND * 255, RND * 255, RND * 255
    _LIMIT 5
LOOP

SUB ball (x, y, size, r, g, b)
    'This SUB draws a gradient ball with given color.

    'see current display status
    displayStatus%% = _AUTODISPLAY

    'turn off screen updates while we draw
    _DISPLAY

    reg = .4

    'if size is larger than value colors given,
    'adjust the reg value to step down at a slower rate.
    'This prevents thick black rim around larger balls
    'that have a too low a given color value.
    IF size > r AND size > g AND size > b THEN
        IF r > g AND r > b THEN reg = r / size * .4
        IF g > r AND g > b THEN reg = g / size * .4
        IF b > r AND b > g THEN reg = b / size * .4
    END IF

    'now draw the ball using CIRCLE.
    'Using smaller STEP value than 1 prevents gaps.
    FOR s = 0 TO size STEP .4
        CIRCLE (x, y), s, _RGB(r, g, b)
        r = r - reg: g = g - reg: b = b - reg
    NEXT

    'show the ball
    _DISPLAY

    'If autodislay was previously on, turn it back on
    IF displayStatus%% = -1 THEN _AUTODISPLAY

END SUB

Find my programs here in Dav's QB64 Corner
Reply
#2
That's good stuff.  Thanks for sharing!

BAM Version (I had to do some tweaking to get that working):
Reply
#3
My DrawBalls were improved by OldMoses Sin even smallest!!!
Code: (Select All)
dh = _DesktopHeight * .85
Screen _NewImage(dh, dh, 32)

Do
    drawBall Rnd * dh, Rnd * dh, 5, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
    _Limit 5
Loop


Sub drawBall (x, y, r, c As _Unsigned Long)
    Dim rred As Long, grn As Long, blu As Long, rr, f
    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
    For rr = r To 0 Step -0.25 ' step -1 with Filled Circle
        f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
        Circle (x, y), rr, _RGB32(rred * f, grn * f, blu * f)
        ' better with Filled Circle
    Next
End Sub
b = b + ...
Reply
#4
Cool!  That's a slick way.  Looks good.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#5
Hey CharlieJV, Sorry I didn’t see your post up there before.  Thanks.

BAM s awesome!

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#6
Dav, nice program and with bplus' changes too. I modified it so it stopped with _KEYDOWN(27). Also changed so the radius varied from 5 to 10 inclusive. Maybe if it could be changed so the colors were yellowish or orangish in the majority, with a couple of red, blue and green balls, they would begin to look like a lumpy cluster of stars. Heart
Reply
#7
Thanks, mnrvovrfc.

Here's another version I played around with today, using SQR + PSET.  Added transparency.  Small, but slower though.

- Dav

Code: (Select All)

SCREEN _NEWIMAGE(800, 600, 32)

DO
    ball RND * _WIDTH, RND * _HEIGHT, RND * 400 + 25, RND * 255, RND * 255, RND * 255, 100 + RND * 155
    _LIMIT 5
LOOP UNTIL INKEY$ <> ""

SUB ball (x, y, size, r, g, b, a)
    FOR y2 = y - size TO y + size
        FOR x2 = x - size TO x + size
            clr = (size - (SQR((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
            IF clr > 0 THEN PSET (x2, y2), _RGBA(clr * r, clr * g, clr * b, a)
        NEXT
    NEXT
END SUB

Find my programs here in Dav's QB64 Corner
Reply
#8
(07-11-2023, 04:44 AM)CharlieJV Wrote: That's good stuff.  Thanks for sharing!

BAM Version (I had to do some tweaking to get that working):

Alternative BAM version by ZXDUNNY, using SIN-based gradient instead of linear:
Reply
#9
And scrolling gradiant balls:


Yeah, dropped the resolution a bit to keep decent performance.
Reply
#10
(07-11-2023, 12:35 PM)Dav Wrote: [...]

BAM s awesome!

- Dav

Hey, thanks.  For a browser-based little guy, I'm pretty pleased with it so far.  Loads to do, which I don't mind 'cause it is a whole ton of fun marrying BASIC and TiddlyWiki.
Reply




Users browsing this thread: 6 Guest(s)