QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Works in Progress v
Fall Banner bplus WIP

Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Threaded Mode
Fall Banner bplus WIP
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#1
09-03-2023, 09:10 PM
OK much better! I got the leaves falling while the Title is printing out plus it looks like strong wind is blowing them off.

Fall Banner 2023 bplus WIP

Code: (Select All)
'Option _Explicit
'_Title "Fall Foliage Banner"
' 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

Type new_Leaf
    x As Single
    y As Single
    w As Single
    h As Single
    c As _Unsigned Long
    isFree As Integer
    randomMove As Integer
    yvel As Single
    xvel As Single
    yacc As Single
    xacc As Single
End Type

Const gravity = .0005
Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind
Dim Shared lastLeaf As Long
Dim Shared stopFrame As Long


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 = 970 ' for banner
ymx = 256
Screen _NewImage(xmx, ymx, 32)
FontImage = _NewImage(_Width, 100, 32)

Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner
LoadPatterns9x9 spattern$()
Dim As Long i, scene
Dim trees, y, r, h, tim

While 1
    'Draw scene:
    ReDim Shared leaf(30000) As new_Leaf
    totalLeaves = 0
    stopFrame = 0
    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)
        lien 0, i, xmx, i
    Next

    'fallen leaves:
    For i = 1 To 50 'less of these at start, as they'll grow in number anyway
        createLeaf rand&(0, xmx), rand&(horizon * 1.002, ymx)
    Next

    ' trees
    trees = rand&(5, 12)
    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&(50, xmx - 50), y, r, 90, h, 0
    Next
    '_PutImage (20, 80)-(150, 210), Logo, 0
    '_PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
    'FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00, 1
    '_Display
    If scene < -1 Then _FreeImage scene
    scene = _CopyImage(0)
    tim = Timer(.01)
    'Animate scene:
    While (Timer(.01) < tim + 30) Or (tim > Timer(.01)) ' + 20 leaves off the N
        If Rnd < .5 Then wind = Rnd / 150 - Rnd / 800 Else wind = 0
        _PutImage , scene
        letLeafGo
        For i = 1 To totalLeaves
            moveLeaf leaf(i)
            drawLeaf leaf(i)
        Next
        _PutImage (20, 80)-(150, 210), Logo, 0
        _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
        FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00
        _Display
        _Limit 30
    Wend
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~& = _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 > 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

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 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 createLeaf (x, y)
    Dim sp, leafs, n, xoff, yoff, woff, hoff
    sp = 15: leafs = rand&(0, 2)
    For n = 1 To leafs
        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&(50, 250), rand&(25, 255), rand&(0, 40))
    Next
End Sub

Sub moveLeaf (idx As new_Leaf)
    If idx.randomMove = 1 Then
        idx.randomMove = -1
    Else
        idx.randomMove = 1
    End If

    If idx.isFree Then
        'leaves falling
        If idx.y < horizon Then
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
        Else
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y >= horizon Then idx.isFree = 0
        End If

        idx.xacc = idx.xacc + wind
        idx.xvel = idx.xvel + idx.xacc
        idx.x = idx.x + idx.xvel
        If Rnd <= .02 And wind Then idx.x = idx.x + idx.randomMove
        If Rnd <= .02 And wind Then idx.y = idx.y + idx.randomMove

    Else
        'leaves waving in their branch
        If idx.y < horizon Then
            If idx.randomMove = 1 Then
                idx.randomMove = -1
            Else
                idx.randomMove = 1
            End If
            If Rnd <= .01 Then idx.x = idx.x + idx.randomMove
        End If
    End If
End Sub

Sub allFree
    Dim i&
    For i& = 1 To totalLeaves
        leaf(i&).isFree = -1
    Next
End Sub

Sub letLeafGo
    Dim which&, i&
    If Timer(.01) - lastLeaf > .002 Then
        For i& = 1 To 10
            which& = rand&(1, totalLeaves)
            If which& < 1 Then which& = 1
            If which& > totalLeaves Then which& = totalLeaves
            leaf(which&).isFree = -1
            lastLeaf = Timer
        Next
    End If
End Sub

Sub drawLeaf (idx As new_Leaf)
    Color idx.c
    fRectStep idx.x, idx.y, idx.w, idx.h
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
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) + "..22222.."
    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) + "..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....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
b = b + ...
Find
Reply
grymmjack Offline
a friendly old nerd
*******
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation: 45
#2
09-04-2023, 12:01 AM
Looks great @bplus! Well done.

https://staging.qb64phoenix.com/

I put it online so you could see. I also modified it to use 1400 to show you what it will look like live.

LMK if it's ok.

Heart
grymmjack (gj!)
GitHub | YouTube | Soundcloud | 16colo.rs
Website Find
Reply
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#3
09-04-2023, 01:31 AM (This post was last modified: 09-04-2023, 01:40 AM by bplus.)
(09-04-2023, 12:01 AM)grymmjack Wrote: Looks great @bplus! Well done.

https://staging.qb64phoenix.com/

I put it online so you could see. I also modified it to use 1400 to show you what it will look like live.

LMK if it's ok.

Heart

Yeah see I'd rather not have scroll bars, wow even a vertical one!

Imagine what Leonardo would say if they put the Mona Lisa in scroll bars.

Here is my view of it:
   
It's not terrible because the Font Title fits and you can see at least one Logo. Wow a vertical scroll bar too, rats!

Gotta say it is really cool to see the animation in a banner! Thanks @grymmjack for the test.
b = b + ...
Find
Reply
mnrvovrfc Away
Posting Freak
*****
Posts: 1,587
Threads: 59
Joined: Jul 2022
Reputation: 52
#4
09-04-2023, 01:57 AM
I'm using Firefox v117 AppImage on Debian v12 "Bookworm", MATE desktop (old GNOME).

Maybe it's just me, but the animation interrupts before it finishes drawing all the letters on the top. It goes drawing each block of the letters slowly because it also has to drop some leaves from the trees. It looks great, only it doesn't finish drawing the message. I don't mind the scrollbars but the right-hand-side QB64PE logo, which is hidden at first is becoming lonely. I hope this description is helpful.
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#5
09-04-2023, 02:04 AM (This post was last modified: 09-04-2023, 02:09 AM by bplus.)
(09-04-2023, 01:57 AM)mnrvovrfc Wrote: I'm using Firefox v117 AppImage on Debian v12 "Bookworm", MATE desktop (old GNOME).

Maybe it's just me, but the animation interrupts before it finishes drawing all the letters on the top. It goes drawing each block of the letters slowly because it also has to drop some leaves from the trees. It looks great, only it doesn't finish drawing the message. I don't mind the scrollbars but the right-hand-side QB64PE logo, which is hidden at first is becoming lonely. I hope this description is helpful.

Ah the timer is different in Linux. The drawing of letters was timed in Windows to complete the drawing of letters in Title AND allow allot more leaves to fall before switching to the next scene. I could set a flag in the FPrint sub letting the main code know when the letters are done instead of using a timer.
Or maybe it is allot of processing for CPU and it is needing more than 1/30 of a second to complete a loop. That's more likely what is off. The flag should help that too.
b = b + ...
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#6
09-04-2023, 02:54 AM (This post was last modified: 09-04-2023, 03:11 AM by bplus.)
FontFlag is working great! I can get most of leaves fallen before cycling around to main loop for another set.

Fall Banner with moving leaves and FontFlag

Code: (Select All)


'Option _Explicit

'_Title "Fall Foliage Banner Move Leaves bak 2023-09-03"

' 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



Type new_Leaf

    x As Single

    y As Single

    w As Single

    h As Single

    c As _Unsigned Long

    isFree As Integer

    randomMove As Integer

    yvel As Single

    xvel As Single

    yacc As Single

    xacc As Single

End Type



Const gravity = .0010

Dim Shared totalLeaves As Long

Dim Shared horizon

Dim Shared wind

Dim Shared lastLeaf As Long

Dim Shared stopFrame As Long

Dim Shared FontFlag As Long ' to signal Font has been finished





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 = 970 ' for banner

ymx = 256

Screen _NewImage(xmx, ymx, 32)



Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner

LoadPatterns9x9 spattern$()

Dim As Long i, scene

Dim trees, y, r, h, tim



While 1

    'Draw scene:

    ReDim Shared leaf(30000) As new_Leaf

    totalLeaves = 0

    stopFrame = 0

    FontFlag = 0

    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)

        lien 0, i, xmx, i

    Next



    'fallen leaves:

    For i = 1 To 50 'less of these at start, as they'll grow in number anyway

        createLeaf rand&(0, xmx), rand&(horizon * 1.002, ymx)

    Next



    ' trees

    trees = rand&(5, 12)

    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&(50, xmx - 50), y, r, 90, h, 0

    Next

    '_PutImage (20, 80)-(150, 210), Logo, 0

    '_PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0

    'FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00, 1

    '_Display

    If scene < -1 Then _FreeImage scene

    scene = _CopyImage(0)

    tim = Timer(.01)

    'Animate scene:

    While FontFlag < 1500 ' keep going 1500 more loops to drop allot of leaves

        If Rnd < .4 Then wind = Rnd / 50 - Rnd / 800 Else wind = 0

        _PutImage , scene

        letLeafGo

        For i = 1 To totalLeaves

            moveLeaf leaf(i)

            drawLeaf leaf(i)

        Next

        _PutImage (20, 80)-(150, 210), Logo, 0

        _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0

        FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00

        _Display

        _Limit 30

    Wend

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~& = _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 > 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



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 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 createLeaf (x, y)

    Dim sp, leafs, n, xoff, yoff, woff, hoff

    sp = 15: leafs = rand&(0, 2)

    For n = 1 To leafs

        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&(50, 250), rand&(25, 255), rand&(0, 40))

    Next

End Sub



Sub moveLeaf (idx As new_Leaf)

    If idx.randomMove = 1 Then

        idx.randomMove = -1

    Else

        idx.randomMove = 1

    End If



    If idx.isFree Then

        'leaves falling

        If idx.y < horizon Then

            idx.yacc = idx.yacc + 3 * gravity

            idx.yvel = idx.yvel + idx.yacc

            idx.y = idx.y + idx.yvel

        Else

            idx.yacc = idx.yacc + 3 * gravity

            idx.yvel = idx.yvel + idx.yacc

            idx.y = idx.y + idx.yvel

            If idx.y >= horizon Then idx.isFree = 0

        End If



        idx.xacc = idx.xacc + wind

        idx.xvel = idx.xvel + idx.xacc

        idx.x = idx.x + idx.xvel

        If Rnd <= .02 And wind Then idx.x = idx.x + idx.randomMove

        If Rnd <= .02 And wind Then idx.y = idx.y + idx.randomMove



    Else

        'leaves waving in their branch

        If idx.y < horizon Then

            If idx.randomMove = 1 Then

                idx.randomMove = -1

            Else

                idx.randomMove = 1

            End If

            If Rnd <= .01 Then idx.x = idx.x + idx.randomMove

        End If

    End If

End Sub



Sub allFree

    Dim i&

    For i& = 1 To totalLeaves

        leaf(i&).isFree = -1

    Next

End Sub



Sub letLeafGo

    Dim which&, i&

    If Timer(.01) - lastLeaf > .002 Then

        For i& = 1 To 10

            which& = rand&(1, totalLeaves)

            If which& < 1 Then which& = 1

            If which& > totalLeaves Then which& = totalLeaves

            leaf(which&).isFree = -1

            lastLeaf = Timer

        Next

    End If

End Sub



Sub drawLeaf (idx As new_Leaf)

    Color idx.c

    fRectStep idx.x, idx.y, idx.w, idx.h

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) + "...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) + "..22222.."

    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) + "..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....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
b = b + ...
Find
Reply
grymmjack Offline
a friendly old nerd
*******
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation: 45
#7
09-04-2023, 12:26 PM
(09-04-2023, 01:31 AM)bplus Wrote: Yeah see I'd rather not have scroll bars, wow even a vertical one!

Imagine what Leonardo would say if they put the Mona Lisa in scroll bars.

Here is my view of it:

It's not terrible because the Font Title fits and you can see at least one Logo. Wow a vertical scroll bar too, rats!

Gotta say it is really cool to see the animation in a banner! Thanks @grymmjack for the test.

I can try to get rid of the scrollbars.
grymmjack (gj!)
GitHub | YouTube | Soundcloud | 16colo.rs
Website Find
Reply
grymmjack Offline
a friendly old nerd
*******
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation: 45
#8
09-04-2023, 12:48 PM
(09-04-2023, 01:31 AM)bplus Wrote: Yeah see I'd rather not have scroll bars, wow even a vertical one!

I have updated staging with your banner FontFlag and added the following for your code to remove the scrollbars in qbjs:

Code: (Select All)
Import Dom From "lib/web/dom.bas"
Dom.Container().style.overflow = "hidden"

Put this right at the top.
grymmjack (gj!)
GitHub | YouTube | Soundcloud | 16colo.rs
Website Find
Reply
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#9
09-04-2023, 02:42 PM
OK thanks @grymmjack

I am getting use to seeing this with only the left Logo only. Not bad.

I hope this version works in Linux as it does in Windows. Might take a really long time to print all Letters and do another 1500 loops of falling leaves on slower machines. So basically one banner set per visit?

Next fix, don't allow leaves to land on tree trunks a foot or 2 up from the ground. Doesn't look right.
b = b + ...
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation: 216
#10
09-04-2023, 09:27 PM (This post was last modified: 09-04-2023, 10:50 PM by bplus.)
OK lot's of little things including fixing font prints, adding treeType to fix leaves sticking to trees 2 feet up the trunk. I tried Point first to detect tree trunk color. It did not work all that great in QB64 and QBJS did not like at all. So I found another way around by redrawing the tree trunks.

So here is latest:
[Broken link error #413]
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???

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

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
    xvel As Single
    yacc As Single
    xacc 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

While 1
    'Draw scene:
    ReDim Shared leaf(30000) As new_Leaf
    totalLeaves = 0
    stopFrame = 0
    FontFlag = 0
    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 50 'less of these at start, as they'll grow in number anyway
        createLeaf rand&(0, xmx), rand&(horizon * 1.002, 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 < 1500 ' keep going 1500 more loops to drop allot of leaves
        If Rnd < .4 Then wind = Rnd / 50 - Rnd / 800 Else wind = 0
        _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
        _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
    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 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 hor  and falling
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y >= horizon Then ' dont stop on tree trunk

                ' QBJS doesn't like point  it's OK it wasn't working very well anyway
                'If Point(idx.x, idx.y) <> TreeTrunkClr Then
                '    If Point(idx.x + idx.w, idx.y + idx.h) <> TreeTrunkClr Then
                '        If Point(idx.x + .5 * idx.w, idx.y + .5 * idx.h) <> TreeTrunkClr Then

                idx.isFree = 0

                '        End If
                '    End If
                'End If

            End If
        End If

        idx.xacc = idx.xacc + wind
        idx.xvel = idx.xvel + idx.xacc
        idx.x = idx.x + idx.xvel
        If Rnd <= .1 Then idx.x = idx.x + idx.ry: idx.rx = -idx.rx
        If Rnd <= .1 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry

    Else
        'leaves waving in their branch
        If idx.y < horizon Then
            If Rnd <= .02 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            If Rnd <= .02 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 <= .025 Then idx.x = idx.x + 1
            If Rnd <= .0025 Then idx.y = idx.y + 1

            ' QBJS doesn't like Point  it wasn't working very well anyway
            'If Point(idx.x + 1, idx.y) <> TreeTrunkClr Then
            '    If Point(idx.x + 1 + idx.w, idx.y + idx.h) <> TreeTrunkClr Then
            '        If Point(idx.x + 1 + .5 * idx.w, idx.y + .5 * idx.h) <> TreeTrunkClr Then
            '            idx.isFree = 0
            '        End If
            '    End If
            'End If

        End If
    End If
End Sub

Sub allFree
    Dim i&
    For i& = 1 To totalLeaves
        leaf(i&).isFree = -1
    Next
End Sub

Sub letLeafGo
    Dim which&, i&
    For i& = 1 To 5
        which& = rand&(1, totalLeaves)
        If which& < 1 Then which& = 1
        If which& > totalLeaves Then which& = totalLeaves
        leaf(which&).isFree = -1
    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

   
b = b + ...
Find
Reply




Users browsing this thread: 12 Guest(s)