OK here is our Fall Banner ![Smile Smile](https://staging.qb64phoenix.com/images/smilies/smile.png)
QB64PE FALL EDITION
The following is just the still shot (partial because my screen is not 1400 wide)
Works in QB64pe too:
Surprised the Circle Fill routine works without the QBJS fix in it.
![Smile Smile](https://staging.qb64phoenix.com/images/smilies/smile.png)
QB64PE FALL EDITION
The following is just the still shot (partial because my screen is not 1400 wide)
Works in QB64pe too:
Code: (Select All)
'Option _Explicit
'_Title "Fall Foliage 2017-10-21 by bplus"
'fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
'test landscape and portrait views for Android
'xmx = min(xmax, 400) : ymx = min(700, ymax) 'portrait
'OK it's just plain better in landscape view
' 2023-08-30 start of QBJS Banner
'now for full viewing enjoyment
'xmx = xmax : ymx = ymax
Const xmx = 1400
Const ymx = 256
Screen _NewImage(xmx, ymx, 32)
Dim spattern$(0 To 255)
LoadPatterns9x9 spattern$()
Dim n, horizon, i, trees, y, r, h
'_ScreenMove 100, 20 'adjust as needed _MIDDLE needs a delay .5 or more for me
n = 3
While 1
If n < 15 Then n = n + 3
horizon = rand%(.8 * ymx, .9 * ymx)
For i = 0 To horizon
midInk 0, 0, 128, 10, 120, 128, i / horizon
lien 0, i, xmx, i
Next
For i = horizon To ymx
midInk 70, 108, 30, 60, 10, 5, (i - horizon) / (ymx - horizon)
lien 0, i, xmx, i
Next
For i = 1 To xmx * ymx * .00018
leaf rand%(0, xmx), rand%(horizon * 1.002, ymx)
Next
If n < .01 * xmx Then trees = n Else trees = rand%(.002 * xmx, .03 * xmx)
For i = 1 To trees
y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
r = .01 * y: h = rand%(y * .15, y * .18)
branch rand%(10, xmx - 10), y, r, 90, h, 0
Next
FPrint "QB64PE FALL EDITION", spattern$(), 80, 10, 6, 2, &HFFFFFFFF
Sleep 10
Wend
Sub branch (xx, yy, startrr, angDD, lengthh, levv)
Dim x, y, lev, length, angd, startr, x2, y2, dx, dy, i
Dim bc&
x = xx: y = yy
lev = levv
length = lengthh
angd = angDD
startr = startrr
x2 = x + Cos(_D2R(angd)) * length
y2 = y - Sin(_D2R(angd)) * length
dx = (x2 - x) / length
dy = (y2 - y) / length
bc& = _RGB(30 + 6 * lev, 15 + 3 * lev, 5 + 2 * lev)
For i = 0 To length
Color bc&
fCirc x + dx * i, y + dy * i, startr
Next
If lev > 1 Then leaf x2, y2
If .8 * startr < .1 Or lev > 7 Or length < 3 Then Exit Sub
lev = lev + 1
branch x2, y2, .8 * startr, angd + 22 + rand%(-10, 19), rand%(.75 * length, .9 * length), lev
branch x2, y2, .8 * startr, angd - 22 - rand%(-10, 19), rand%(.75 * length, .9 * length), lev
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fCirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , 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), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End Sub
Sub fRect (x1, y1, x2, y2, c&)
Line (x1, y1)-(x2, y2), c&, BF
End Sub
Sub fRectStep (x1, y1, x2, y2)
Line (x1, y1)-Step(x2, y2), , BF
End Sub
Sub lien (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2)
End Sub
Sub leaf (x, y)
Dim sp, leafs, n, xoff, yoff, woff, hoff
sp = 15: leafs = rand%(xmx * ymx * .00001, xmx * ymx * .00002)
For n = 1 To leafs
Color _RGB(rand%(50, 250), rand%(25, 255), rand%(0, 40))
xoff = x + Rnd * sp - Rnd * sp
yoff = y + Rnd * sp - Rnd * sp
woff = 3 + Rnd * 3
hoff = 3 + Rnd * 3
fRectStep xoff, yoff, woff, hoff
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 FPrint (s$, PA$(), x%, y%, scale%, spacing%, colr~&)
' s$ is string to "print" out
' PA$() is the array of string holding the font THE SQUARE pattern (must be NxN pattern)
' x, y top, left corner of print just like _PrintString
' scale is multiplier of pixeled font at NxN so now is Scale * N x Scale * N
' spacing is amount of pixels * scale between letters
' color~& type allows up to _RGB32() colors
Dim As Integer ls, l, a, sq, r, c, i, digi
Dim d$
ls = Len(s$)
For l = 1 To ls
a = Asc(s$, l)
If Len(PA$(a)) Then ' do we have a pattern
sq = Sqr(Len(PA$(a)))
'Print Chr$(a), sq 'debug
For digi = 1 To 9
d$ = _Trim$(Str$(digi))
For r = 0 To sq - 1 ' row and col of letter block
For c = 0 To sq - 1
i = (r * sq) + c + 1
$If WEB Then
i = i + 1
$End If
If Mid$(PA$(a), i, 1) = d$ Then
Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
_Delay .04
End If
Next
Next
Next
End If
Next
End Sub
Sub LoadPatterns9x9 (SPattern() As String)
Dim As Integer a
a = Asc("S")
SPattern(a) = SPattern(a) + "..111111."
SPattern(a) = SPattern(a) + ".2......."
SPattern(a) = SPattern(a) + ".2......."
SPattern(a) = SPattern(a) + "..3......"
SPattern(a) = SPattern(a) + "...333..."
SPattern(a) = SPattern(a) + "......4.."
SPattern(a) = SPattern(a) + ".......4."
SPattern(a) = SPattern(a) + ".......4."
SPattern(a) = SPattern(a) + "5555555.."
a = Asc("T")
SPattern(a) = SPattern(a) + "111111111"
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
SPattern(a) = SPattern(a) + "....2...."
a = Asc("A")
SPattern(a) = SPattern(a) + "...122..."
SPattern(a) = SPattern(a) + "..1...2.."
SPattern(a) = SPattern(a) + "..1...2.."
SPattern(a) = SPattern(a) + ".1.....2."
SPattern(a) = SPattern(a) + ".1333332."
SPattern(a) = SPattern(a) + ".1.....2."
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
a = Asc("F")
SPattern(a) = SPattern(a) + "122222222"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1333333.."
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
a = Asc("I")
SPattern(a) = SPattern(a) + ".2222222."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + "....1...."
SPattern(a) = SPattern(a) + ".3333333."
a = Asc("G")
SPattern(a) = SPattern(a) + ".11111111"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2....4444"
SPattern(a) = SPattern(a) + "2.......5"
SPattern(a) = SPattern(a) + "2......35"
SPattern(a) = SPattern(a) + "2.....3.5"
SPattern(a) = SPattern(a) + ".33333..5"
a = Asc("Q")
SPattern(a) = SPattern(a) + "..11111.."
SPattern(a) = SPattern(a) + ".2.....4."
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2....5..4"
SPattern(a) = SPattern(a) + "2.....5.4"
SPattern(a) = SPattern(a) + ".2....55."
SPattern(a) = SPattern(a) + "..33333.5"
a = Asc("O")
SPattern(a) = SPattern(a) + "..11111.."
SPattern(a) = SPattern(a) + ".2.....4."
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + ".2.....4."
SPattern(a) = SPattern(a) + "..33333.."
a = Asc("D")
SPattern(a) = SPattern(a) + "1222222.."
SPattern(a) = SPattern(a) + "1......3."
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1......3."
SPattern(a) = SPattern(a) + "1444444.."
a = Asc("6")
SPattern(a) = SPattern(a) + "..11111.."
SPattern(a) = SPattern(a) + ".2......."
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2.444444."
SPattern(a) = SPattern(a) + "24......4"
SPattern(a) = SPattern(a) + "2.......4"
SPattern(a) = SPattern(a) + ".2.....4."
SPattern(a) = SPattern(a) + "..33333.."
a = Asc("H")
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "133333332"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
a = Asc("4")
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "133333332"
SPattern(a) = SPattern(a) + "........2"
SPattern(a) = SPattern(a) + "........2"
SPattern(a) = SPattern(a) + "........2"
SPattern(a) = SPattern(a) + "........2"
a = Asc("E")
SPattern(a) = SPattern(a) + "111111111"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2444444.."
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "2........"
SPattern(a) = SPattern(a) + "233333333"
a = Asc("N")
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "12......3"
SPattern(a) = SPattern(a) + "1.2.....3"
SPattern(a) = SPattern(a) + "1..2....3"
SPattern(a) = SPattern(a) + "1...2...3"
SPattern(a) = SPattern(a) + "1....2..3"
SPattern(a) = SPattern(a) + "1.....2.3"
SPattern(a) = SPattern(a) + "1......23"
SPattern(a) = SPattern(a) + "1.......3"
a = Asc("B")
SPattern(a) = SPattern(a) + "1222222.."
SPattern(a) = SPattern(a) + "1......3."
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1......3."
SPattern(a) = SPattern(a) + "1333333.."
SPattern(a) = SPattern(a) + "1......4."
SPattern(a) = SPattern(a) + "1.......4"
SPattern(a) = SPattern(a) + "1......4."
SPattern(a) = SPattern(a) + "1444444.."
a = Asc("L")
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "122222222"
a = Asc("U")
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + ".2222222."
a = Asc("P")
SPattern(a) = SPattern(a) + "1222222.."
SPattern(a) = SPattern(a) + "1......2."
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1......2."
SPattern(a) = SPattern(a) + "1333332.."
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
SPattern(a) = SPattern(a) + "1........"
a = Asc("R")
SPattern(a) = SPattern(a) + "1222222.."
SPattern(a) = SPattern(a) + "1......2."
SPattern(a) = SPattern(a) + "1.......2"
SPattern(a) = SPattern(a) + "1......2."
SPattern(a) = SPattern(a) + "1333332.."
SPattern(a) = SPattern(a) + "1.....4.."
SPattern(a) = SPattern(a) + "1......4."
SPattern(a) = SPattern(a) + "1.......4"
SPattern(a) = SPattern(a) + "1.......4"
End Sub
Surprised the Circle Fill routine works without the QBJS fix in it.
b = b + ...