+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: SMcNeill (https://staging.qb64phoenix.com/forumdisplay.php?fid=29)
+---- Thread: Rainbow Text (/showthread.php?tid=1377)
Rainbow Text - SMcNeill - 01-08-2023
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