Improved my small Gradient Ball drawing SUB
#11
A Voronoi Variation:
Code: (Select All)
_Title "Shading Voronoi Demo 2" 'b+ 2019-12-11  shading 2021-05-10
' 2022-01-30 mod with random dark shades run continuously
' 2023-07-11 Demo 2 mod with changing radii and holding shading to black

Const xymax = 700, nPoints = 20
Type pType
    x As Single
    y As Single
    c As _Unsigned Long
End Type
Screen _NewImage(xymax, xymax, 32)
_ScreenMove 300, 20
Randomize Timer
restart:
Dim pts(1 To nPoints) As pType
For i = 1 To nPoints
    pts(i).x = xymax * Rnd
    pts(i).y = xymax * Rnd
    pts(i).c = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
Next
For i = 1 To nPoints
    Circle (pts(i).x, pts(i).y), 5, pts(i).c
Next
Dim RC As _Unsigned Long
div = 20
Do
    'RC = _RGB32(Rnd * 60, Rnd * 60, Rnd * 60)
    RC = &HFF000000
    For y = 0 To xymax
        For x = 0 To xymax
            minD = 49000
            For p = 1 To nPoints
                d = ((pts(p).x - x) ^ 2 + (pts(p).y - y) ^ 2) ^ .5
                If d < minD Then minD = d: saveP = p
            Next
            PSet (x, y), Ink~&(pts(saveP).c, RC, minD / div)
        Next
    Next
    _Delay 2
    div = div + 20
    If div > 120 Then div = 20: GoTo restart
Loop

Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub

Function Ink~& (c1 As _Unsigned Long, c2 As _Unsigned Long, fr##)
    Dim R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
End Function
b = b + ...
Reply


Messages In This Thread
RE: Improved my small Gradient Ball drawing SUB - by bplus - 07-12-2023, 12:12 AM



Users browsing this thread: 4 Guest(s)