Sounds like a keyword my av-ee-tar would like. ELSEIF ya don't, I'm eh gonna blast youse.
Okay, settle down Yosemite, and let's have a look at this handy conditional statement.
SYNTAX:
IF foo1 THEN
ELSEIF foo2 THEN
END IF
Usage: Handles multiple conditions while excluding program flow through unnecessary evaluation statements.
This is a nice alternative to SELECT CASE, and better than forcing your program through multiple IF/THEN statements, which could cause more than one desired condition to be triggered.
Example:
Code: (Select All)
a = 1: b = 2
IF a > b OR j = 0 THEN
PRINT "1"
ELSEIF a = b OR j = 0 THEN PRINT "2"
ELSEIF a < b OR j = 0 THEN PRINT "3"
END IF
PRINT "---------------------------------"
IF a > b OR j = 0 THEN PRINT "1"
IF a = b OR j = 0 THEN PRINT "2"
IF a < b OR j = 0 THEN PRINT "3"
So by using IF THEN with ELSEIF in a block statement we get an output of '1' and done in the first condition block vs all three numbers printed out in the second IF/THEN only block.
Edit: Oh, here's a fun coding fact, inspired by mn's post below....
We can code a regular IF/THEN non-block statement with THEN (line number)...
...but with an IF/THEN/ESLEIF, the THEN part cannot reference a line number without using GOTO with it.:
Code: (Select All)
IF a = b THEN 5 ' This is accepted.
PRINT "Skip me!"
5 PRINT "Okay, I skipped you!"
IF a = b THEN
PRINT "Okay!"
ELSEIF a < b THEN GOTO 5 ' You have to include GOTO here or it won't compile.
END IF
As usual, this post is to inform the users who want to test or use InForm with the latest QB64PE version (3.4.1).
Once again, I've updated my multi lingual installation bash script that now includes both QB64PE v 3.4.1 and InForm-pe (a fork of InForm v 1.3 that I made to communicate with the latest QB64PE release).
This script allows you to create icons starters for QB64PE, InForm-pe and the QB64PE folder directly on your desktop and adds the ability to invoque QB64PE from any terminal session without being into the QB64PE folder (as you can do with any standard compiler such as gcc).
You can get my "pure" bash script here: BashScript
The script can also cleanly uninstall QB64PE and InForm (they're installed in the /opt/qb64pe folder to not interfer with your own installation) as well as their different starters (desktop and programming menu) and you're free to copy their complete install folder to any other location that best suits your needs (then you'll have to modify the different starters).
Note: due to my poor and limited programming capabilities, I do not provide any support for InForm (so, no need for a sub-section for me).
Thank you for your return and enjoy QB64PE v 3.4.0 with InForm-pe when creating event driven GUI applications with the ease of the BASIC language.
Here is an interesting one for all you bit flipping coders out there...
_TOGGLEBIT
SYNTAX result = _TOGGLEBIT(numericalVariable, numericalValue)
Usage: For cross breeding elephants and rhinos. What's that good for? Eleph-i-no!
Okay, I know bit-flipping can be used somehow to detect a hardware malfunction in a Windows operating system. I would imagine encryption would be another practical use. I also did some reading on using bit-flipping as an alternative to doing string math, but that was a very involved process, so I have no work created to demonstrate how that would be accomplished.
What I can easily see if we flip the first bit, we can get a 0 or 1, which is good for a toggle function.
Now the easiest method to create your own toggle for a program has been demonstrated in this forum numerous times...
toggle = 1 - toggle Mark posted about that one months ago.
So using toggle = 1 - toggle we start out with toggle = 0, hence 1 - 0 = 1. Loop again and 1 - 1 = 0
Now we can accomplish the exact same toggle effect with _TOGGLEBIT, as follows...
Code: (Select All)
DIM a AS INTEGER ' Also avilable are _INTEGER64, LONG, _UNSIGNED, and _BYTE,
DO
DO
SELECT CASE a
CASE 0
PRINT " Steve is good...";
CASE 1
PRINT " Pete is better!": PRINT
END SELECT
SLEEP
a = _TOGGLEBIT(a, 0)
mykey$ = INKEY$
LOOP UNTIL mykey$ = CHR$(9) OR mykey$ = CHR$(27)
PRINT
FOR i = 0 TO 15
PRINT i; _TOGGLEBIT(a, i)
NEXT
PRINT
LOOP UNTIL mykey$ = CHR$(27)
So maybe this example will goad Steve a "bit" to elaborate on some of his experiences with _TOGGLEBIT. Also, I'd love to hear some comments from @jack about bit-flipping, and his experience with coding decfloat.
t$ = "Frosty the No-man"
_TITLE t$
WIDTH 90, 25
PALETTE 5, 8
COLOR 15, 5
CLS
$UNSTABLE:MIDI
$MIDISOUNDFONT:DEFAULT
PRINT: PRINT " SCREEN ZERO HERO PRESENTS, A FROSTY CHRISTMAS!...": PRINT
DIM song$(1), songhand&(1)
song$(1) = "frosty.mid"
songhand&(1) = _SNDOPEN(song$(1), "stream")
IF songhand&(1) = 0 THEN
PRINT "Error opening file: "; song$(1), _CWD$
END
END IF
_SNDPLAY songhand&(1)
_DELAY 10: CLS: PRINT: _DELAY 1
DO
READ a$
IF a$ = "EOF" THEN EXIT DO
seed = 0
LOCATE , 2
DO
i = i + 1
j = INSTR(seed, a$ + " ", " ")
PRINT MID$(a$, seed, j - seed + 1);
SELECT CASE i
CASE 1
_DELAY .75
CASE 2
_DELAY .35
CASE ELSE
_DELAY .42
END SELECT
seed = j + 1
LOOP UNTIL j = 0
PRINT: PRINT
IF i = 1 THEN _DELAY 1.4 ELSE _DELAY .75
LOOP
DATA "Frosty the snowman, had two very cold snowballs"
DATA "'Til a kid named Sue, thought what she should do, is wrap them in Grandma's shawls"
DATA "Now Frosty the snowman, won't be smiling come Christmas day"
DATA "'Cause the heat from the shawls, melted off his balls, and they dropped and rolled away"
DATA "There must have been, some magic in, that Super Glue we found"
DATA "'Cause when we glued his balls back on, he began to dance around"
DATA "Oh... Frosty the snowman, now he's jolly and that's a fact"
DATA "Even though he knows his snowballs are froze, he's so glad he's got them back..."
DATA "FROSTY!"
DATA "EOF"
Requires the midi file attached below if you don't already have it from Dav's screensaver... (Thanks Dav!)
Usage: Restricts the printable area of the screen.
Okay, let's take this puppy for a spin.
Use VIEW PRINT anytime you want to divide your text screen into a skin and message area.
Code: (Select All)
msg$ = "My Header"
COLOR 15, 1
LOCATE 1, 1: PRINT SPACE$(_WIDTH * 2);
LOCATE _HEIGHT - 1, 1: PRINT SPACE$(_WIDTH * 2);
LOCATE _HEIGHT, 1: PRINT SPACE$(_WIDTH);
LOCATE 1, _WIDTH / 2 - LEN(msg$) / 2: PRINT msg$;
LOCATE 2, 1: PRINT STRING$(_WIDTH, 196);
LOCATE _HEIGHT - 1, 1: PRINT STRING$(_WIDTH, 196);
PALETTE 5, 25
COLOR 7, 5
top% = 3
bottom% = _HEIGHT - 2
VIEW PRINT top% TO bottom%
CLS 2
msg$ = "Press [1] for info / Press [2] to make fun of Steve / Press [Esc] to end"
COLOR 15, 1: LOCATE _HEIGHT, _WIDTH / 2 - LEN(msg$) / 2: PRINT msg$; ' Look, we can print to the last row without changing VIEW PRINT.
LOCATE top%, 1
COLOR 7, 5
DO
_LIMIT 30
b$ = INKEY$
IF LEN(b$) THEN
SELECT CASE b$
CASE "1"
PRINT "INFO!"
CASE "2"
PRINT "Ha Ha Ha! ";
CASE CHR$(27)
EXIT DO
END SELECT
END IF
LOOP
SYSTEM
What's cool about VIEW PRINT is it leaves the last row unrestricted. That means we can print to the last row anytime we want, without changing the VIEW PRINT parameters.
What else do we need to know here, Pete?
Well, glad you asked!
1) CLEAR does not affect VIEW PRINT.
2) RUN removes VIEW PRINT.
3) CLS clears the whole screen.
4) CLS 2 only clears the VIEW PRINT area.
5) To get rid of the view print restriction, just code: VIEW PRINT
6) Remember when printing to the bottom of the screen to end your print statement with a semi-colon, so it doesn't scroll.
7) If you switch screens and switch back, you will have to redo your VIEW PRINT statement.
8) The top parameter must always be smaller than the bottom parameter. (If you're too dumb to figure that one out, switch to FreeBASIC).
Option _Explicit
_Title "Programmable Tree Lights v2" ' b+ 2020-12-19 2022-12-18 fixed k$
Randomize Timer
Const Xmax = 700, Ymax = 700, N_Rows = 10, N_Cols = 2 * N_Rows - 1
Const X_Spacer = 30, Y_Spacer = 52, X_Offset = 50
Type ColorSeed
Red As Single
Green As Single
Blue As Single
End Type
Dim Shared ColorSet(10) As ColorSeed, ColorSetIndex As Long
Dim Shared pR, pG, pB, pN, pStart, pMode$
Dim Shared TG(1 To N_Cols, 1 To N_Rows) As Long
Screen _NewImage(Xmax, Ymax, 32)
_Delay .25
_ScreenMove _Middle
Dim As Long i, row, Col, nstars, back, cc
Dim horizon, r, land
Dim l$, o$, b$, k$
' setup some color seeds in ColorSet user can change out with Shift + digit key
For i = 0 To 9 ' 10 random color seeds
resetPlasma
ColorSet(i).Red = pR: ColorSet(i).Green = pG: ColorSet(i).Blue = pB
Next
'Stringing the lights on tree, adjusted to fit mostly on the tree 2*N - 1 Pryramid
For row = 1 To 10
l$ = xStr$(2 * row - 1, "X")
o$ = xStr$(10 - row, "O")
b$ = o$ + l$ + o$
For Col = 1 To N_Cols
If Mid$(b$, Col, 1) = "O" Then TG(Col, row) = 0 Else TG(Col, row) = -1
Next
Print b$
Next
' making the stars
horizon = Ymax - 4 * r
nstars = 100
Dim xstar(100), ystar(100), rstar(100)
For i = 1 To 100
xstar(i) = Rnd * (Xmax): ystar(i) = Rnd * horizon:
If i < 75 Then
rstar(i) = 0
ElseIf i < 95 Then
rstar(i) = 1
Else
rstar(i) = 2
End If
Next
Cls
' make a circle tree and align circles to tree with spacers and offsets with new Pyramid Scheme
'Pinetree 25, 30, 650, 600
'FOR row = 1 TO N_Rows
' FOR col = 1 TO N_Cols
' IF TG(col, row) THEN CIRCLE (col * X_Spacer + X_Offset, row * Y_Spacer), 10
' NEXT
'NEXT
' making the background
back = _NewImage(_Width, _Height, 32)
Cls
horizon = Ymax - 100
For i = 0 To horizon
Line (0, i)-(Xmax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
Next
land = Ymax - horizon
For i = horizon To Ymax
cc = 128 + (i - horizon) / land * 127
Line (0, i)-(Xmax, i), _RGB32(cc, cc, cc)
Next
For i = 1 To 100
fcirc xstar(i), ystar(i), rstar(i), &HFFEEEEFF
Next
_PutImage , 0, back
ColorSetIndex = 1: pMode$ = "h"
show ' avoid the pause for key checking
Do
k$ = InKey$
If Len(k$) Then
If InStr("0123456789", k$) > 0 Then
ColorSetIndex = Val(k$)
ElseIf InStr("vhde", k$) > 0 Then
pMode$ = k$
End If
End If
_PutImage , back, 0
show
_Display
_Limit 10
Loop Until _KeyDown(27)
Sub show
Dim row, prow, col
Pinetree 25, 30, 650, 600
_Title "Programmable Tree Lights (0-9) Color Set: " + TS$(ColorSetIndex) + " (v, h, d, e) Mode: " + pMode$
pR = ColorSet(ColorSetIndex).Red: pG = ColorSet(ColorSetIndex).Green: pB = ColorSet(ColorSetIndex).Blue
pStart = pStart + 1
Select Case pMode$
Case "h"
For row = 1 To N_Rows
prow = pStart + row
For col = 1 To N_Cols
pN = prow
If TG(col, row) Then Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
Next
Next
Case "v"
For row = 1 To N_Rows
For col = 1 To N_Cols
pN = pStart + col
If TG(col, row) Then Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
Next
Next
Case "d"
For row = 1 To N_Rows
For col = 1 To N_Cols
pN = pStart + col - row
If TG(col, row) Then Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
Next
Next
Case "e"
For row = 1 To N_Rows
For col = 1 To N_Cols
pN = pStart + row + col
If TG(col, row) Then Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
Next
Next
End Select
End Sub
Sub Lite (x, y, c As _Unsigned Long)
Dim cR, cG, cB, cA, r
cAnalysis c, cR, cG, cB, cA
For r = 35 To 0 Step -2
fcirc x, y, r, _RGB32(cR, cG, cB, 1)
Next
fcirc x, y, 4, c
End Sub
Sub Pinetree (treeX, treeY, wide, high)
Dim bpx, bpy, tpx, bpxx, bpyy, aa, ra, tpy, ht, xs, xsh, rs, tpxx, tpyy, fra, x1, x2, y1, y2, wf, hf
'tannen baum by PeterMaria W orig 440x460
'fits here LINE (0, 0)-(440, 410), , B
Static t&
If t& = 0 Then
t& = _NewImage(440, 410, 32)
_Dest t&
bpx = 220: bpy = 410
tpx = bpx
For aa = -4 To 4
bpxx = bpx + aa
bpyy = bpy - 390
Line (bpxx, bpy)-(bpx, bpyy), _RGB32(30, 30, 0)
Next
ra = 160
tpy = bpy - 40
For ht = 1 To 40
For xs = -100 To 100 Step 40
xsh = xs / 100
rs = Rnd * 4 / 10
tpxx = tpx + (xsh * ra)
tpyy = tpy - rs * ra
Line (tpx, tpy)-(tpxx, tpyy), _RGB32(50, 40, 20)
For aa = 1 To 30
fra = Rnd * 10 / 10 * ra
x1 = tpx + (xsh * fra)
y1 = tpy - rs * fra
x2 = tpx + xsh * (fra + ra / 5)
y2 = tpy - rs * fra + (-rs + (Rnd * 8) / 10 - 0.4) * (ra / 5)
Line (x1, y1)-(x2, y2), _RGB32(Rnd * 80, Rnd * 70 + 40, Rnd * 60)
Next
Next
ra = ra - 4
tpy = tpy - 9
Next
_Dest 0
End If
wf = wide / 440: hf = high / 410
_PutImage (treeX, treeY)-Step(440 * wf, 410 * hf), t&, 0
End Sub
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 Plasma~& ()
pN = pN + 1 'dim shared cN as _Integer64, pR as integer, pG as integer, pB as integer
Plasma~& = _RGB32(127 + 127 * Sin(pR * pN), 127 + 127 * Sin(pG * pN), 127 + 127 * Sin(pB * pN))
End Function
Sub resetPlasma ()
pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: pN = 0
End Sub
Function xStr$ (x, strng$)
Dim i, rtn$
For i = 1 To x
rtn$ = rtn$ + strng$
Next
xStr$ = rtn$
End Function
Function TS$ (n As Integer)
TS$ = _Trim$(Str$(n))
End Function
'from Steve Gold standard
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C
Line (CX - Y, CY + X)-(CX + Y, CY + X), C
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C
Line (CX - X, CY + Y)-(CX + X, CY + Y), C
Wend
End Sub
Since someone took down the code that had nice trees and snow fall...
Code: (Select All)
'$INCLUDE:'SaveImage.BI'
Const SaveTextAs256Color = 0 'Flag to Save as 256 color file or 32-bit color file, when converting SCREEN 0 to an image
' Set to TRUE (any non-zero value) to save text screens in 256 color mode.
' Set to FALSE (zero) to save text screens in 32-bit color mode.
_Title "Winter Christmas Theme Banner 11, space to take snap, escape for new tree layout" ' b+ 2022-11-07 Banner 5 with better and Rnd Pine Trees
'started from Snowjob code
'snow making machine
Type PARTICLE
x As Single
y As Single
dx As Single
dy As Single
size As Single
density As Single
angle As Single
dir As Single
maxy As Single
End Type
Const nTrees = 70
Dim As Long logo, santa, fnt, wallpaper, t
ReDim savefile As String
savefile = "Merry Christmas Banner 2022.png"
'logo = _LoadImage("peLogo.png")
'santa = _LoadImage("Kindpng_301203.png")
'_ClearColor &HFFFFFFFF, santa
fnt = _LoadFont("FROSW___.ttf", 100)
restart: ' new wallpaper background
If wallpaper <= -1 Then _FreeImage wallpaper ' avoid memory leak
wallpaper = _NewImage(XMAX, YMAX, 32)
_Font fnt, wallpaper
_PrintMode _KeepBackground , wallpaper
_Dest wallpaper
drawLandscape
For t = 1 To nTrees
NewTree wallpaper
Next
'_PutImage (25, 18)-Step(220, 220), logo, wallpaper
_Dest wallpaper
'_PutImage (1207, 127)-Step(50, 87), santa, wallpaper
Color _RGB32(200, 0, 0)
_PrintString (10, 120), "Merry Christmas 2022", wallpaper
_Dest 0
Dim As Long nLayers, flakes, layer, flake
Dim horizon
nLayers = 15
flakes = 2 ^ (nLayers + 1) - 1
ReDim snow(flakes) As PARTICLE
horizon = .5 * YMAX
For layer = nLayers To 1 Step -1
For flake = 0 To 2 ^ layer
snow(flake).x = Rnd * 2 * XMAX - .5 * XMAX
snow(flake).y = Rnd * 2 * YMAX - YMAX ' <<<<<<<<<<<<<< fix clear clearing when first start by spreading over 2 screens
snow(flake).dx = .1 * (nLayers + 1 - layer) * Cos(Rnd * _Pi(.6666) + _Pi(.0833))
If snow(flake).dx < -.2 Then snow(flake).dx = -snow(flake).dx ' <<<<<<<<<<<<< add a little wind
snow(flake).dy = .1 * (nLayers + 1 - layer) * Sin(Rnd * _Pi(.6666) + _Pi(.0833))
If snow(flake).dy < .2 Then snow(flake).dy = .2 ' <<<<<<<<<<<<<< make sure everything is falling
snow(flake).size = .5 * (nLayers - layer)
snow(flake).density = 2.3 + Rnd * .5
snow(flake).angle = Rnd * _Pi
If Rnd < .5 Then snow(flake).dir = -1 Else snow(flake).dir = 1
snow(flake).maxy = horizon + (nLayers + 1 - layer) * 30
Next
Next
Dim k$
Dim result
While _KeyDown(27) = 0 ' <<<<<<<<<<<<< allow escape from full screen
_PutImage , wallpaper&, 0
k$ = InKey$
For flake = flakes To 0 Step -1
If Rnd < .2 Then
snow(flake).x = snow(flake).x + snow(flake).dx + Rnd * 2 - 1
snow(flake).y = snow(flake).y + snow(flake).dy + Rnd * 2 - 1
Else
snow(flake).x = snow(flake).x + snow(flake).dx
snow(flake).y = snow(flake).y + snow(flake).dy
End If
If snow(flake).size <= 1 Then
PSet (snow(flake).x, snow(flake).y), _RGBA32(255, 255, 255, 80)
ElseIf snow(flake).size <= 2 Then
Circle (snow(flake).x, snow(flake).y), 1, _RGBA32(255, 255, 255, 100)
Else
snow(flake).angle = snow(flake).angle + snow(flake).dir * _Pi(1 / 100) ' <<<<<< turn flakes more
rFlake snow(flake).x, snow(flake).y, snow(flake).size, snow(flake).density, snow(flake).angle
End If
If snow(flake).y > snow(flake).maxy Or snow(flake).x < -.5 * XMAX Or snow(flake).x > 1.5 * XMAX Then
snow(flake).x = Rnd * 2 * XMAX - .5 * XMAX
snow(flake).y = Rnd * YMAX - 1.1 * YMAX
End If
Next
_Display
If k$ = " " Then
result = SaveImage(savefile, 0, 0, 0, _Width - 1, _Height - 1)
If result = 1 Then 'file already found on drive
Kill savefile 'delete the old file
result = SaveImage(savefile, 0, 0, 0, _Width - 1, _Height - 1) 'save the new one again
End If
If result >= 0 Then Cls: Print "Save Failed": Beep: End ' <<<<<<<<<<<<<<<<<<<<<<<<<<<< beep = failed
End If
_Limit 60
Wend
GoTo restart
Sub rFlake (x, y, r, DV, rAng)
'DV = flake density
Dim As Long a
Dim armX, armY
Color _RGBA32(225, 225, 245, r ^ 2 * 30)
For a = 0 To 5
armX = x + r * Cos(a * _Pi(1 / 3) + rAng)
armY = y + r * Sin(a * _Pi(1 / 3) + rAng)
Line (x, y)-(armX, armY)
If r > 2.5 Then rFlake armX, armY, r / DV, DV, rAng
Next
End Sub
Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub
Function rand% (lo%, hi%)
rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
Sub drawLandscape
'needs midInk, rand
'the sky
Dim As Long i, rgb, mountain
Dim startH, updown, range, lastX, Xright, y, x
For i = 0 To .33 * YMAX
midInk 120, 50, 100, 255, 255, 150, i / (.3 * YMAX) '<<<<<<<<<<<< dark on top lighter redder lower
Line (0, i)-(XMAX, i)
Next
'the land
startH = .2 * YMAX
rgb = 195 ' <<<<<<<<<<<<<<<<<<<<<< less white
For mountain = 1 To 6
Xright = 0
y = startH
While Xright < XMAX
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
updown = (Rnd * .8 - .35) / (mountain * 2)
range = Xright + rand%(15, 35) * 3.5 / mountain
lastX = Xright - 1
Color _RGB32(rgb + 10 * mountain, rgb + 8 * mountain, rgb + 10 * mountain)
For x = Xright To range
y = y + updown
Line (lastX, y)-(x, YMAX), , BF 'just lines weren't filling right
lastX = x
Next
Xright = range
Wend
'_DELAY 1
rgb = rand%(rgb, rgb + 20)
startH = startH + rand%(5, 20)
Next
End Sub
Sub NewTree (d&)
Dim h, w
horz = _Height - 135 - 60
h = Rnd * 100 + 25
w = h / 2 + Rnd * h / 8 - h / 16
Pinetree _Width * Rnd, horz - .5 * h, w, h, d&
End Sub
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub
A simple Marquee effect to display a horizontally scrolling seasonal message.
Code: (Select All)
'merry marquee
_Title "Merry Marquee"
Screen _NewImage(800, 288, 256)
msg = _NewImage(800, 288, 256)
_Dest msg
Color 8, 0
A$ = " Have A MERRY CHRISTMAS and a HaPpY NeW YeAr !!! "
Print A$
_Source msg
_Dest 0
Color 15, 0
pmax = Int((_Width) / 8)
prows = Len(A$) * 8
If prows < pmax Then
maxp = prows
Else
maxp = (prows + 1) - pmax
End If
For pstart = 0 To maxp
_Limit 20
Cls
For y = 0 To 16
x = 1
Color 15, 0
If Int(Rnd * 20) < 5 Then _PrintString (Int(Rnd * _Width), Int(Rnd * _Height)), "*"
Do
If Point(pstart - 1 + x, y) <> 0 Then
Color Int(1 + Rnd * 8)
Locate y + 2, x + 1
Print Chr$(219)
End If
x = x + 1
Loop Until x = pmax - 8
Next y
_Display
Next pstart
![[Image: tongue.png]](https://staging.qb64phoenix.com/images/smilies/tongue.png)
