Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Drawing Tools Subs or Functions with Demo
#58
Here's a try at a Rainbow:
Code: (Select All)
_Title "Rainbow test" ' b+ 2025-04-30
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
Const xmax = 800
Const ymax = 600

horizon% = Int(ymax * .6)
For i = 550 To 0 Step -1 '                      the sun
    FC3 400, horizon%, i, midInk~&(255, 255, 0, 50, 50, 208, i / 550)
Next

For i = horizon% To ymax '              the land
    Line (0, i)-(xmax, i), midInk~&(200, 200, 60, 45, 48, 0, (i - horizon%) / (ymax - horizon%))
Next

For r = 450 To 350 Step -.25
    drawArc 400, horizon% + 50, r, _Pi, _Pi, rainbow~&((r - 350) / 100, 40)
Next
Sleep

' blend 2 colors according to fractional distance of 2nd to first color
Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Function

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' fill circle #3 mod
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

Function rainbow~& (fraction, alpha)
    radians = fraction * 2 * _Pi
    b = Sin(radians) * 127 + 128
    g = Sin(radians - 2 / 3 * _Pi) * 127 + 128
    r = Sin(radians + 2 / 3 * _Pi) * 127 + 128
    rainbow~& = _RGB32(r, g, b, alpha)
End Function

Sub drawArc (xc, yc, radius, rStart, rMeasure, colr As _Unsigned Long)
    ' xc, yc Center for arc circle
    ' rStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
    ' rMeasure is the measure of Arc in Radain units, use _D2R for conversion from Degrees to Radians
    ' Arc will start at rStart and go clockwise around for rMeasure Radians

    Dim rEnd, stepper, a, x, y

    rEnd = rStart + rMeasure
    stepper = 1 / radius ' the bigger the radius the smaller  the steps
    For a = rStart To rEnd Step stepper
        x = xc + radius * Cos(a)
        y = yc + radius * Sin(a)
        If a > rStart Then Line -(x, y), colr Else PSet (x, y), colr
    Next
End Sub

Update: added an Alpha setting to the Rainbow~&(fraction) coloring Function.


Attached Files Thumbnail(s)
   
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply


Messages In This Thread
RE: Drawing Tools Subs or Functions with Demo - by bplus - 04-30-2025, 01:48 PM

Possibly Related Threads…
Thread Author Replies Views Last Post
  Dialog Tools bplus 4 1,464 02-18-2025, 12:18 AM
Last Post: bplus
  Item$ Tools for Getting Strings to Behave Like Arrays bplus 1 920 02-05-2024, 01:14 AM
Last Post: bobalooie

Forum Jump:


Users browsing this thread: 1 Guest(s)