Posts: 272
Threads: 24
Joined: Apr 2022
Reputation:
59
Quote:Hey is the QBJS Server is giving me an error when I try to test the Shared Code link from this forum. I retried 3 times. The code works fine in QBJS but the shared code link 413's an Error???
Sounds like the query string portion of the URL has exceeded the max length. When you paste in the share URL replace the ? with a #.
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
09-05-2023, 02:08 AM
(This post was last modified: 09-05-2023, 02:13 AM by bplus.)
OK it is up to 568 lines now.
Fall Banner bplus update 2023-09-04
Update: yep!
I don't know maybe it needs a flying saucer?
b = b + ...
Posts: 2,698
Threads: 327
Joined: Apr 2022
Reputation:
217
09-05-2023, 02:18 AM
(This post was last modified: 09-05-2023, 02:19 AM by SMcNeill.)
A rotating pumpkin for Spookday!
And a phoenix for Turkeyday!
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation:
45
(09-05-2023, 02:08 AM)bplus Wrote: I don't know maybe it needs a flying saucer?
Do it!
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
09-05-2023, 12:27 PM
(This post was last modified: 09-05-2023, 12:31 PM by bplus.)
Today I want to make less leaves and fluffier, be more subject to wind whims which also needs a fix.
Turkeys!  They will be hiding over on the right side ;-))
Oh I have a turkey image, running for it's life. That actually would work better with my scrolling landscape.
b = b + ...
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
09-05-2023, 02:51 PM
(This post was last modified: 09-05-2023, 02:54 PM by bplus.)
OK the leaves are more satisfactory in my eyes and experience.
Fall banner bplus 2023-09-05A
Code: (Select All) 'Option _Explicit
'_Title "Fall Foliage Banner Move Leaves" 2023-09-03 bak copy
' started 2017-10-21 by bplus as: fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
' 2023-08-30 start of QBJS Banner
' 2023-08-31 Logo and Hills added
' 2023-09-01 Fellippe I see contributed allot to orig code with moving leaves
' Also thanks to grymmjack for getting me starting of PFont and font patterns.
' Also thanks to dbox for catching all my errors with QBJS.
' 2023-09-03 try to fix font print to print while leaves are falling
' tweak numbers for falling leaves for more and not too leaden.
' 2023-09-03 FontFlag to signal FPrint is done
' 2023-09-04 do not stop leaves falling when on a tree trunk
' Ran into problems with QBJS handling Point see commented code in MoveLeaf
' So this keeps moving leaves without Point
' Clean up code a bit fix letters shadows, toss junk subs
' Aha! found a way to get leaves off tree trunks = redraw trunks!
' New Type Tree
' 2023-09-05 fix wind so it is continuous between 0 and .5?
' less leaves too
Type treeType
x As Single
y As Single
r As Single
h As Single
End Type
Type new_Leaf
x As Single
y As Single
w As Single
h As Single
c As _Unsigned Long
isFree As Integer
rx As Integer
ry As Integer
yvel As Single
yacc As Single
End Type
Const gravity = .0010
Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind
Dim Shared stopFrame As Long
Dim Shared FontFlag As Long ' to signal Font has been finished
'Dim Shared TreeTrunkClr As _Unsigned Long
' TreeTrunkClr = _RGB32(60, 30, 15) ' lev 0 color QBJS Point not working
Dim As Long Logo
$If WEB Then
Logo = _LoadImage("https://qb64phoenix.com/forum/attachment.php?aid=2206", 32)
$Else
Logo = _LoadImage("peLogo.png", 32)
$End If
'now for full viewing enjoyment xmx = screen width, ymx = screen height
Dim Shared xmx, ymx
xmx = 1200 ' for banner 1400 doesn't fit my screen so using 1200 for broader expanse look
ymx = 256
Screen _NewImage(xmx, ymx, 32) ' grymmjack set on making this 1400 it appears OK
Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner
LoadPatterns9x9 spattern$()
Dim As Long i, scene, trees, windChange
Dim gust
While 1
'Draw scene:
ReDim Shared leaf(30000) As new_Leaf
totalLeaves = 0
stopFrame = 0
FontFlag = 0
windChange = 1
gust = .01
Cls
horizon = rand&(.8 * ymx, .9 * ymx)
'sky and hill background
drawLandscape
For i = horizon To ymx
midInk 160, 188, 50, 100, 60, 25, (i - horizon) / (ymx - horizon)
Line (0, i)-(xmx, i)
Next
'fallen leaves:
For i = 1 To 300 'less of these at start, as they'll grow in number anyway
createLeaf rand&(0, xmx), rand&(horizon + 5, ymx)
Next
' trees
trees = rand&(5, 12)
ReDim tree(1 To trees) As treeType
For i = 1 To trees
tree(i).x = rand&(50, xmx - 50)
tree(i).y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
tree(i).r = .01 * tree(i).y
tree(i).h = rand&(tree(i).y * .15, tree(i).y * .18)
branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, 7
Next
If scene < -1 Then _FreeImage scene
scene = _CopyImage(0) ' take a picture of bare trees before they are clothed with leaves
'Animate scene:
While FontFlag < 2500 ' keep going more loops to drop allot of leaves allow trees to become bare
If wind + windChange * gust < 0 Then windChange = -windChange
If wind + windChange * gust > 5 Then windChange = -windChange
wind = wind + windChange * gust
_PutImage , scene
letLeafGo
For i = 1 To totalLeaves
moveLeaf leaf(i)
Line (leaf(i).x, leaf(i).y)-Step(leaf(i).w, leaf(i).h), leaf(i).c, BF
Next
_PutImage (20, 80)-(150, 210), Logo, 0
_PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
' this draws one letter squares at a time until title is complete
' the FontFlag is increased by 1 for 1500 loops after letters are complete
FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00
' draw tree trunks again
For i = 1 To trees
branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, -1
Next
' debugging wind and changes
'_Title "Wind:" + Str$(wind) + " WindChange:" + Str$(windChange)
_Display
_Limit 30
Wend
Wend
Sub branch (xx, yy, startrr, angDD, lengthh, levv, stopLev)
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~& = _RGB32(60 + 12 * lev, 30 + 7 * lev, 15 + 5 * lev)
If 2 * startr <= 1 Then
Line (x, y)-(x2, y2), bc~&
Else
For i = 0 To length
fCirc x + dx * i, y + dy * i, startr, bc~&
Next
End If
If lev > 1 Then createLeaf x2, y2
If .8 * startr < .1 Or lev > stopLev 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, stopLev
branch x2, y2, .8 * startr, angD - 22 - rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
End Sub
Sub fCirc (CX As Long, CY As Long, R As Long, c As _Unsigned 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), 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, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), c, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), c, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), c, BF
Wend
End Sub
Sub createLeaf (x, y)
Dim sp, xoff, yoff, woff, hoff
If Rnd < .6 Then
sp = 15
xoff = x + Rnd * sp - Rnd * sp
yoff = y + Rnd * sp - Rnd * sp
woff = 3 + Rnd * 3
hoff = 3 + Rnd * 3
totalLeaves = totalLeaves + 1
If totalLeaves > UBound(leaf) Then ReDim _Preserve leaf(1 To UBound(leaf) + 5000) As new_Leaf
leaf(totalLeaves).x = xoff
leaf(totalLeaves).y = yoff
leaf(totalLeaves).w = woff
leaf(totalLeaves).h = hoff
leaf(totalLeaves).c = _RGB32(rand&(100, 250), rand&(50, 255), rand&(0, 40))
If Rnd < .5 Then leaf(totalLeaves).rx = -2 Else leaf(totalLeaves).rx = 2
If Rnd < .5 Then leaf(totalLeaves).ry = -1 Else leaf(totalLeaves).ry = 1
End If
End Sub
Sub moveLeaf (idx As new_Leaf)
If idx.isFree Then 'leaves falling
If idx.y < horizon Then ' above ground
idx.yacc = idx.yacc + 3 * gravity
idx.yvel = idx.yvel + idx.yacc
idx.y = idx.y + idx.yvel
Else ' below horizon and falling time to stop
idx.yacc = idx.yacc + 3 * gravity
idx.yvel = idx.yvel + idx.yacc
idx.y = idx.y + idx.yvel
If idx.y > horizon Then ' stop leaves from going to bottom of screen
idx.isFree = 0
End If
End If
idx.x = idx.x + wind
Else
If idx.y < horizon Then 'leaves waving in their branch
If Rnd <= wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
If Rnd <= wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
Else 'leaves are on ground but can move too down and to right only
If Rnd <= wind / 500 Then ' move down wind
idx.x = idx.x + 2
Else
If Rnd < wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
End If
If Rnd <= wind / 500 Then ' move down wind
idx.y = idx.y + 1
Else
If Rnd < wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
End If
End If
End If
End Sub
Sub letLeafGo
Dim which&, i&
For i& = 1 To 5
If Rnd <= wind / 30 Then
which& = rand&(1, totalLeaves)
'If which& < 1 Then which& = 1
'If which& > totalLeaves Then which& = totalLeaves
leaf(which&).isFree = -1
End If
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&
Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
Dim lastx As Single, X As Long
'the sky
For i = 0 To ymx
midInk 150, 150, 220, 255, 255, 255, i / ymx
Line (0, i)-(xmx, i)
Next
'the land
startH = ymx - 200
rr = 125: gg = 140: bb = 120
For mountain = 1 To 4
Xright = 0
y = startH
While Xright < xmx
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown = (Rnd * .8 - .35) * (mountain * .5)
range = Xright + rand(15, 25) * 2.5 / mountain
lastx = Xright - 1
For X = Xright To range
y = y + upDown
Color _RGB(rr, gg, bb)
Line (lastx, y)-(X, ymx), , BF 'just lines weren't filling right
lastx = X
Next
Xright = range
Wend
rr = rand&(rr + 65, rr): gg = rand&(gg + 45, gg): bb = rand&(bb - 25, bb)
If rr < 0 Then rr = 0
If gg < 0 Then gg = 0
If bb < 0 Then bb = 0
startH = startH + rand&(5, 20)
Next
End Sub
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 As Long frame
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% + 4, y% + r * scale% + 4)-Step(scale% - 1, scale% - 1), &HFF000000, BF
Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% - 1, y% + r * scale% - 1)-Step(scale% - 1, scale% - 1), &HFFFFFFFF, BF
Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
frame = frame + 1
If frame >= stopFrame Then
stopFrame = stopFrame + 1
Exit Sub
End If
End If
Next
Next
Next
End If
Next
FontFlag = FontFlag + 1
' _Title Str$(FontFlag) ' checking how long it needs to cycle after letters are complete
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) + "...133..."
SPattern(a) = SPattern(a) + "..1...3.."
SPattern(a) = SPattern(a) + "..1...3.."
SPattern(a) = SPattern(a) + ".1.....3."
SPattern(a) = SPattern(a) + ".1222223."
SPattern(a) = SPattern(a) + ".1.....3."
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
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) + "..11111.."
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) + "..33333.."
a = Asc("G")
SPattern(a) = SPattern(a) + ".1111111."
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....3"
SPattern(a) = SPattern(a) + "..1.....3"
SPattern(a) = SPattern(a) + ".1......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "122222223"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
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
Less leaves and way less falling leaves so a set will run much longer, 2500 loops instead of 1500, to get barer trees before switch.
b = b + ...
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
Ok I was able to work in my pumpkin but QBJS insists on giving it cheekbones ;-))
Fall Banner with pumpkin
Code: (Select All) 'Option _Explicit
'_Title "Fall Foliage Banner Move Leaves" 2023-09-03 bak copy
' started 2017-10-21 by bplus as: fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
' 2023-08-30 start of QBJS Banner
' 2023-08-31 Logo and Hills added
' 2023-09-01 Fellippe I see contributed allot to orig code with moving leaves
' Also thanks to grymmjack for getting me starting of PFont and font patterns.
' Also thanks to dbox for catching all my errors with QBJS.
' 2023-09-03 try to fix font print to print while leaves are falling
' tweak numbers for falling leaves for more and not too leaden.
' 2023-09-03 FontFlag to signal FPrint is done
' 2023-09-04 do not stop leaves falling when on a tree trunk
' Ran into problems with QBJS handling Point see commented code in MoveLeaf
' So this keeps moving leaves without Point
' Clean up code a bit fix letters shadows, toss junk subs
' Aha! found a way to get leaves off tree trunks = redraw trunks!
' New Type Tree
' 2023-09-05 fix wind so it is continuous between 0 and .5?
' less leaves too
Type treeType
x As Single
y As Single
r As Single
h As Single
End Type
Type new_Leaf
x As Single
y As Single
w As Single
h As Single
c As _Unsigned Long
isFree As Integer
rx As Integer
ry As Integer
yvel As Single
yacc As Single
End Type
Const gravity = .0010
Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind
Dim Shared stopFrame As Long
Dim Shared FontFlag As Long ' to signal Font has been finished
Dim Shared sx
Dim As Long Logo
$If WEB Then
Logo = _LoadImage("https://qb64phoenix.com/forum/attachment.php?aid=2206", 32)
$Else
Logo = _LoadImage("peLogo.png", 32)
$End If
'now for full viewing enjoyment xmx = screen width, ymx = screen height
Dim Shared xmx, ymx
xmx = 1200 ' for banner 1400 doesn't fit my screen so using 1200 for broader expanse look
ymx = 256
Screen _NewImage(xmx, ymx, 32) ' grymmjack set on making this 1400 it appears OK
Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner
LoadPatterns9x9 spattern$()
Dim As Long i, scene, trees, windChange, pumpkinImage, lp, pr, d
Dim gust
pr = 100
While 1
'Draw scene:
ReDim Shared leaf(30000) As new_Leaf
totalLeaves = 0
stopFrame = 0
FontFlag = 0
windChange = 1
gust = .01
Cls
horizon = rand&(.8 * ymx, .9 * ymx)
'sky and hill background
drawLandscape
For i = horizon To ymx
midInk 160, 188, 50, 100, 60, 25, (i - horizon) / (ymx - horizon)
Line (0, i)-(xmx, i)
Next
'fallen leaves:
For i = 1 To 300 'less of these at start, as they'll grow in number anyway
createLeaf rand&(0, xmx), rand&(horizon + 5, ymx)
Next
' trees
trees = rand&(5, 12)
ReDim tree(1 To trees) As treeType
For i = 1 To trees
tree(i).x = rand&(50, xmx - 50)
tree(i).y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
tree(i).r = .01 * tree(i).y
tree(i).h = rand&(tree(i).y * .15, tree(i).y * .18)
branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, 7
Next
If scene < -1 Then _FreeImage scene
scene = _CopyImage(0) ' take a picture of bare trees before they are clothed with leaves
'Animate scene:
While FontFlag < 2500 ' keep going more loops to drop allot of leaves allow trees to become bare
lp = (lp + 1) Mod 10
If lp = 1 Then
If pumpkinImage < -1 Then _FreeImage pumpkinImage
pumpkinImage = _NewImage(300, 200, 32)
_Dest pumpkinImage
sx = sx + rand&(-4, 4)
If sx > .7 * pr / 10 Then d = -1 * d: sx = 0
If sx < -.7 * pr / 10 Then d = -1 * d: sx = 0
pumpkin 149, 100, pr, 2
_Dest 0
End If
If wind + windChange * gust < 0 Then windChange = -windChange
If wind + windChange * gust > 5 Then windChange = -windChange
wind = wind + windChange * gust
_PutImage , scene
letLeafGo
For i = 1 To totalLeaves
moveLeaf leaf(i)
Line (leaf(i).x, leaf(i).y)-Step(leaf(i).w, leaf(i).h), leaf(i).c, BF
Next
_PutImage (20, 80)-(150, 210), Logo, 0
_PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
' this draws one letter squares at a time until title is complete
' the FontFlag is increased by 1 for 1500 loops after letters are complete
FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00
' draw tree trunks again
For i = 1 To trees
branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, -1
Next
' hey pumpkin!
_PutImage (690, 80), pumpkinImage, 0
' debugging wind and changes
'_Title "Wind:" + Str$(wind) + " WindChange:" + Str$(windChange)
_Display
_Limit 30
Wend
Wend
Sub branch (xx, yy, startrr, angDD, lengthh, levv, stopLev)
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~& = _RGB32(60 + 12 * lev, 30 + 7 * lev, 15 + 5 * lev)
If 2 * startr <= 1 Then
Line (x, y)-(x2, y2), bc~&
Else
For i = 0 To length
fCirc x + dx * i, y + dy * i, startr, bc~&
Next
End If
If lev > 1 Then createLeaf x2, y2
If .8 * startr < .1 Or lev > stopLev 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, stopLev
branch x2, y2, .8 * startr, angD - 22 - rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
End Sub
Sub fCirc (CX As Long, CY As Long, R As Long, c As _Unsigned 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), 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, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), c, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), c, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), c, BF
Wend
End Sub
Sub createLeaf (x, y)
Dim sp, xoff, yoff, woff, hoff
If Rnd < .6 Then
sp = 15
xoff = x + Rnd * sp - Rnd * sp
yoff = y + Rnd * sp - Rnd * sp
woff = 3 + Rnd * 3
hoff = 3 + Rnd * 3
totalLeaves = totalLeaves + 1
If totalLeaves > UBound(leaf) Then ReDim _Preserve leaf(1 To UBound(leaf) + 5000) As new_Leaf
leaf(totalLeaves).x = xoff
leaf(totalLeaves).y = yoff
leaf(totalLeaves).w = woff
leaf(totalLeaves).h = hoff
leaf(totalLeaves).c = _RGB32(rand&(100, 250), rand&(50, 255), rand&(0, 40))
If Rnd < .5 Then leaf(totalLeaves).rx = -2 Else leaf(totalLeaves).rx = 2
If Rnd < .5 Then leaf(totalLeaves).ry = -1 Else leaf(totalLeaves).ry = 1
End If
End Sub
Sub moveLeaf (idx As new_Leaf)
If idx.isFree Then 'leaves falling
If idx.y < horizon Then ' above ground
idx.yacc = idx.yacc + 3 * gravity
idx.yvel = idx.yvel + idx.yacc
idx.y = idx.y + idx.yvel
Else ' below horizon and falling time to stop
idx.yacc = idx.yacc + 3 * gravity
idx.yvel = idx.yvel + idx.yacc
idx.y = idx.y + idx.yvel
If idx.y > horizon Then ' stop leaves from going to bottom of screen
idx.isFree = 0
End If
End If
idx.x = idx.x + wind
Else
If idx.y < horizon Then 'leaves waving in their branch
If Rnd <= wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
If Rnd <= wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
Else 'leaves are on ground but can move too down and to right only
If Rnd <= wind / 500 Then ' move down wind
idx.x = idx.x + 2
Else
If Rnd < wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
End If
If Rnd <= wind / 500 Then ' move down wind
idx.y = idx.y + 1
Else
If Rnd < wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
End If
End If
End If
End Sub
Sub letLeafGo
Dim which&, i&
For i& = 1 To 5
If Rnd <= wind / 30 Then
which& = rand&(1, totalLeaves)
'If which& < 1 Then which& = 1
'If which& > totalLeaves Then which& = totalLeaves
leaf(which&).isFree = -1
End If
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&
Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
Dim lastx As Single, X As Long
'the sky
For i = 0 To ymx
midInk 150, 150, 220, 255, 255, 255, i / ymx
Line (0, i)-(xmx, i)
Next
'the land
startH = ymx - 200
rr = 125: gg = 140: bb = 120
For mountain = 1 To 4
Xright = 0
y = startH
While Xright < xmx
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown = (Rnd * .8 - .35) * (mountain * .5)
range = Xright + rand(15, 25) * 2.5 / mountain
lastx = Xright - 1
For X = Xright To range
y = y + upDown
Color _RGB(rr, gg, bb)
Line (lastx, y)-(X, ymx), , BF 'just lines weren't filling right
lastx = X
Next
Xright = range
Wend
rr = rand&(rr + 65, rr): gg = rand&(gg + 45, gg): bb = rand&(bb - 25, bb)
If rr < 0 Then rr = 0
If gg < 0 Then gg = 0
If bb < 0 Then bb = 0
startH = startH + rand&(5, 20)
Next
End Sub
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 As Long frame
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% + 4, y% + r * scale% + 4)-Step(scale% - 1, scale% - 1), &HFF000000, BF
Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% - 1, y% + r * scale% - 1)-Step(scale% - 1, scale% - 1), &HFFFFFFFF, BF
Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
frame = frame + 1
If frame >= stopFrame Then
stopFrame = stopFrame + 1
Exit Sub
End If
End If
Next
Next
Next
End If
Next
FontFlag = FontFlag + 1
' _Title Str$(FontFlag) ' checking how long it needs to cycle after letters are complete
End Sub
Sub pumpkin (cx, cy, pr, limit)
Dim As Long u, i
Dim lastr, dx, tx1, tx2, tx3, ty1, ty3, ty2, ty22, sxs
'carve this!
Color &HFFFF5500
fEllips cx, cy, pr, 29 / 35 * pr
Color &HFF000000
lastr = 2 / 7 * pr
If limit = 2 Then
Do
ellipse cx, cy, lastr, 29 / 35 * pr
lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
If pr - lastr < 1 / 80 * pr Then Exit Do
Loop
End If
' 'flickering candle light
Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)
' eye sockets
ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12
ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12
ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12
ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12
' nose
ftri cx, cy - rand&(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand&(1, 2) * pr / 12, cy + 2 * pr / 12
' evil grin
ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12
ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12
' moving teeth/talk/grrrr..
u = rand&(4, 8)
dx = pr / u
For i = 1 To u
tx1 = cx - 6 * pr / 12 + (i - 1) * dx
tx2 = tx1 + .5 * dx
tx3 = tx1 + dx
ty1 = cy + 5 * pr / 12
ty3 = cy + 5 * pr / 12
ty2 = cy + (4 - Rnd) * pr / 12
ty22 = cy + (6 + Rnd) * pr / 12
ftri tx1, ty1, tx2, ty2, tx3, ty3
ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3
Next
If limit Then
'shifty eyes
If limit = 2 Then sxs = sx Else sxs = .1 * sx
pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
End If
End Sub
'Andy Amaya's triangle fill modified for QB64, use if color already set
Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3)
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single
Dim slope3 As Single
'make copies before swapping
x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then Swap x1, x2: Swap y1, y2
If x3 < x1 Then Swap x1, x3: Swap y1, y3
If x3 < x2 Then Swap x2, x3: Swap y2, y3
If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)
'draw the first half of the triangle
length = x2 - x1
If length <> 0 Then
slope2 = (y2 - y1) / length
For x = 0 To length
Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1))
lastx% = Int(x + x1)
Next
End If
'draw the second half of the triangle
y = length * slope1 + y1: length = x3 - x2
If length <> 0 Then
slope3 = (y3 - y2) / length
For x = 0 To length
If Int(x + x2) <> lastx% Then
Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2))
End If
Next
End If
End Sub
Sub fEllips (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
Dim scale As Single, x As Long, y As Long
scale = yRadius / xRadius
Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
For x = 1 To xRadius
y = scale * Sqr(xRadius * xRadius - x * x)
Line (CX + x, CY - y)-(CX + x, CY + y), , BF
Line (CX - x, CY - y)-(CX - x, CY + y), , BF
Next
End Sub
Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
Dim scale As Single, xs As Long, x As Long, y As Long
Dim lastx As Long, lasty As Long
scale = yRadius / xRadius: xs = xRadius * xRadius
PSet (CX, CY - yRadius): PSet (CX, CY + yRadius)
lastx = 0: lasty = yRadius
For x = 0 To xRadius
y = scale * Sqr(xs - x * x)
Line (CX + lastx, CY - lasty)-(CX + x, CY - y)
Line (CX + lastx, CY + lasty)-(CX + x, CY + y)
Line (CX - lastx, CY - lasty)-(CX - x, CY - y)
Line (CX - lastx, CY + lasty)-(CX - x, CY + y)
lastx = x: lasty = y
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) + "...133..."
SPattern(a) = SPattern(a) + "..1...3.."
SPattern(a) = SPattern(a) + "..1...3.."
SPattern(a) = SPattern(a) + ".1.....3."
SPattern(a) = SPattern(a) + ".1222223."
SPattern(a) = SPattern(a) + ".1.....3."
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "1.......3"
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) + "..11111.."
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) + "..33333.."
a = Asc("G")
SPattern(a) = SPattern(a) + ".1111111."
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....3"
SPattern(a) = SPattern(a) + "..1.....3"
SPattern(a) = SPattern(a) + ".1......3"
SPattern(a) = SPattern(a) + "1.......3"
SPattern(a) = SPattern(a) + "122222223"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
SPattern(a) = SPattern(a) + "........3"
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
b = b + ...
Posts: 1,587
Threads: 59
Joined: Jul 2022
Reputation:
52
If I were even half as clever as you, and designing it for myself, I would get rid of the right-hand-side Phoenix logo and put the pumpkin in its place. But if the turkey has to be included as well...
Otherwise I admit I'm being bothered by the message at the top not being centered. The pumpkin instead of one of the logos would make at least one person want to use the horizontal scrollbar, if you can't get rid of it.
Anyways these are only suggestions. I wrote this for a few chuckles. It works well at my end, draws the entire message, and waits until almost all the leaves are off the trees.
If it were really up to me only, I'd place a prophet on the right-hand side. Then a whirlwind could appear from the left-hand side and lure him away. At least as a limited-time option, could be removed in October. There, I've more or less given away where I'm from.
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
09-05-2023, 06:23 PM
(This post was last modified: 09-05-2023, 06:25 PM by bplus.)
+1 Thankyou for your feedback @mnrvovrfc specially the Linux things. Turns out the FontFlag worked out better in fact several workarounds have worked out better!
Quote:Otherwise I admit I'm being bothered by the message at the top not being centered. The pumpkin instead of one of the logos would make at least one person want to use the horizontal scrollbar, if you can't get rid of it.
I was thinking the pumpkin where it is will balance the left Logo and "center" the Title for those of us with less than 1400 pixel screens. Hard to design anything when you don't know where the right side is going to end up because you don't know where the middle is either. I am prepared to have the right side cut off if your screen doesn't make 1400. The title should just fit on smallest width screen.
b = b + ...
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
09-05-2023, 06:44 PM
(This post was last modified: 09-05-2023, 06:46 PM by bplus.)
Oct 31 I should hand out Trick or Treats
Maybe the flying saucer comes out of the pumpkins nose.
b = b + ...
|
