Rainbow Text

[SMcNeill]

You guys are *really* making me feel odd now, digging up remnants of the past as you are.  What is this, an eulogy for poor Steve?  "He was a great guy, that poor old Steve.  Why just the other day, I found this on my drive that he did/helped me with/whatever...."

I'm not dead yet, dang it!!

Sheesh!!   But, eulogistic or not, there's still no reason not to share some of these old gems.  Thanks go to Terry for finding this one and returning it back into the fold with the rest that I've preserved here in this little Steve(tm) subforum. 

Code: (Select All)

fg& = _NewImage(1280, 720, 32)
white& = _RGB32(255, 255, 255)
Screen fg&
Print "This is a demostration of a simple RainbowText routine."
Print "One Command is being used to generate all the text which follows."
Print "Press any key to see some quick samples."
junk$ = Input$(1)

Cls
text$ = "This is sample text"
RainbowText text$, 0, 0, 380, 220, 0, 0, 0, 0, 0
RainbowText text$, 0, 180, 380, 380, 0, 0, 100, 100, 100
RainbowText text$, 0, 90, 300, 300, 0, 0, 150, 150, 150
RainbowText text$, 0, 270, 460, 300, 0, 0, 50, 100, 150
RainbowText text$, 1, 0, 100, 100, 0, 0, 10, 200, 0
RainbowText text$, -1, 0, 300, 100, 0, 0, 200, 200, 0

Locate 35, 40: Print "Press any key to watch what else you can do!"

junk$ = Input$(1)

Color , _RGB32(0, 0, 255)
direction = .25

Do
    Cls
    i = i + direction
    RainbowText text$, 0, i, 500, 500, 0, 0, r, g, b
    If i > 360 Or i < 0 Then direction = -direction
Loop Until InKey$ <> ""
_AutoDisplay
Locate 10, 10: Print "HA!  Rotating text, and all from 1 simple routine."

Cls


f& = _LoadFont("times.ttf", 100)
Do
    RainbowText text$, 0, 0, 500, 200, f&, 0, 255, 100, b
Loop Until InKey$ <> ""
_AutoDisplay


End


Sub RainbowText (text$, slant%, angle%, x%, y%, font&, b&, r, g, b)
    A = _AutoDisplay: F = _Font: D = _Dest
    dc& = _DefaultColor: bg& = _BackgroundColor
    slant% = slant% + 1 'This keeps slant 0 as neutral
    bgi& = _NewImage(100, 100, 32): _Dest bgi& 'temporary for sizing
    If font& <> 0 Then _Font font&
    length% = _PrintWidth(text$): height% = _FontHeight
    _FreeImage bgi&
    bgi& = _NewImage(length%, height%, 32) 'screen to draw to, the proper size
    _Dest bgi&: If font& <> 0 Then _Font font&
    Color _RGB32(255, 255, 255), b&
    _PrintString (0, 0), text$
    TLC$ = "BL" + Str$(length% \ 2) + "BU" + Str$(height% \ 2)
    RET$ = "BD BL" + Str$(length%)
    _Source bgi&
    _Dest D
    Draw "BM" + Str$(x%) + "," + Str$(y%) + "TA=" + VarPtr$(angle%) + TLC$
    For y = 0 To height% - slant%
        For x = 0 To length% - slant%
            If Point(x, y) <> b& Then
                r = r + 5
                If r > 255 Then r = 0: g = g + 5
                If g > 255 Then g = 0: b = b + 5
                If b > 255 Then b = 0: r = 0
                Draw "C" + Str$(_RGB32(r, g, b)) + "R1" 'color and DRAW each pixel
            Else
                Draw "B R1" 'color and DRAW each pixel
            End If
        Next
        Draw RET$
    Next
    If Not A Then _Display: _AutoDisplay 'Remark this line out if you want to manually use _DISPLAY to show the text
    _FreeImage bgi&
    If font& <> 0 Then _Font F
    Color dc&, bg&
End Sub