Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Fall Banner Contest?
#21
OK here is our Fall Banner Smile

QB64PE FALL EDITION

The following is just the still shot (partial because my screen is not 1400 wide)
   

Works in QB64pe too:
Code: (Select All)
'Option _Explicit
'_Title "Fall Foliage 2017-10-21 by bplus"
'fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
'test landscape and portrait views for Android
'xmx = min(xmax, 400) : ymx = min(700, ymax) 'portrait
'OK it's just plain better in landscape view

' 2023-08-30 start of QBJS Banner

'now for full viewing enjoyment
'xmx = xmax : ymx = ymax

Const xmx = 1400
Const ymx = 256
Screen _NewImage(xmx, ymx, 32)
Dim spattern$(0 To 255)
LoadPatterns9x9 spattern$()
Dim n, horizon, i, trees, y, r, h
'_ScreenMove 100, 20 'adjust as needed _MIDDLE needs a delay .5 or more for me

n = 3
While 1
    If n < 15 Then n = n + 3
    horizon = rand%(.8 * ymx, .9 * ymx)
    For i = 0 To horizon
        midInk 0, 0, 128, 10, 120, 128, i / horizon
        lien 0, i, xmx, i
    Next
    For i = horizon To ymx
        midInk 70, 108, 30, 60, 10, 5, (i - horizon) / (ymx - horizon)
        lien 0, i, xmx, i
    Next
    For i = 1 To xmx * ymx * .00018
        leaf rand%(0, xmx), rand%(horizon * 1.002, ymx)
    Next
    If n < .01 * xmx Then trees = n Else trees = rand%(.002 * xmx, .03 * xmx)
    For i = 1 To trees
        y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
        r = .01 * y: h = rand%(y * .15, y * .18)
        branch rand%(10, xmx - 10), y, r, 90, h, 0
    Next
    FPrint "QB64PE FALL EDITION", spattern$(), 80, 10, 6, 2, &HFFFFFFFF
    Sleep 10
Wend

Sub branch (xx, yy, startrr, angDD, lengthh, levv)
    Dim x, y, lev, length, angd, startr, x2, y2, dx, dy, i
    Dim bc&
    x = xx: y = yy
    lev = levv
    length = lengthh
    angd = angDD
    startr = startrr
    x2 = x + Cos(_D2R(angd)) * length
    y2 = y - Sin(_D2R(angd)) * length
    dx = (x2 - x) / length
    dy = (y2 - y) / length
    bc& = _RGB(30 + 6 * lev, 15 + 3 * lev, 5 + 2 * lev)
    For i = 0 To length
        Color bc&
        fCirc x + dx * i, y + dy * i, startr
    Next
    If lev > 1 Then leaf x2, y2
    If .8 * startr < .1 Or lev > 7 Or length < 3 Then Exit Sub
    lev = lev + 1
    branch x2, y2, .8 * startr, angd + 22 + rand%(-10, 19), rand%(.75 * length, .9 * length), lev
    branch x2, y2, .8 * startr, angd - 22 - rand%(-10, 19), rand%(.75 * length, .9 * length), lev
End Sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fCirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , BF

    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

Sub fRect (x1, y1, x2, y2, c&)
    Line (x1, y1)-(x2, y2), c&, BF
End Sub

Sub fRectStep (x1, y1, x2, y2)
    Line (x1, y1)-Step(x2, y2), , BF
End Sub

Sub lien (x1, y1, x2, y2)
    Line (x1, y1)-(x2, y2)
End Sub

Sub leaf (x, y)
    Dim sp, leafs, n, xoff, yoff, woff, hoff
    sp = 15: leafs = rand%(xmx * ymx * .00001, xmx * ymx * .00002)
    For n = 1 To leafs
        Color _RGB(rand%(50, 250), rand%(25, 255), rand%(0, 40))
        xoff = x + Rnd * sp - Rnd * sp
        yoff = y + Rnd * sp - Rnd * sp
        woff = 3 + Rnd * 3
        hoff = 3 + Rnd * 3
        fRectStep xoff, yoff, woff, hoff
    Next
End Sub

Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub

Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function

Sub FPrint (s$, PA$(), x%, y%, scale%, spacing%, colr~&)
    ' s$ is string to "print" out
    ' PA$() is the array of string holding the font THE SQUARE pattern (must be NxN pattern)
    ' x, y top, left corner of print just like _PrintString
    ' scale is multiplier of pixeled font at NxN so now is Scale * N x Scale * N
    ' spacing is amount of pixels * scale between letters
    ' color~& type allows up to _RGB32() colors
    Dim As Integer ls, l, a, sq, r, c, i, digi
    Dim d$
    ls = Len(s$)
    For l = 1 To ls
        a = Asc(s$, l)
        If Len(PA$(a)) Then ' do we have a pattern
            sq = Sqr(Len(PA$(a)))
            'Print Chr$(a), sq  'debug
            For digi = 1 To 9
                d$ = _Trim$(Str$(digi))
                For r = 0 To sq - 1 ' row and col of letter block
                    For c = 0 To sq - 1
                        i = (r * sq) + c + 1
                        $If WEB Then
                                i = i + 1
                        $End If
                        If Mid$(PA$(a), i, 1) = d$ Then
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
                            _Delay .04
                        End If
                    Next
                Next
            Next
        End If
    Next
End Sub

Sub LoadPatterns9x9 (SPattern() As String)
    Dim As Integer a
    a = Asc("S")
    SPattern(a) = SPattern(a) + "..111111."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "..3......"
    SPattern(a) = SPattern(a) + "...333..."
    SPattern(a) = SPattern(a) + "......4.."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + "5555555.."
    a = Asc("T")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    a = Asc("A")
    SPattern(a) = SPattern(a) + "...122..."
    SPattern(a) = SPattern(a) + "..1...2.."
    SPattern(a) = SPattern(a) + "..1...2.."
    SPattern(a) = SPattern(a) + ".1.....2."
    SPattern(a) = SPattern(a) + ".1333332."
    SPattern(a) = SPattern(a) + ".1.....2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    a = Asc("F")
    SPattern(a) = SPattern(a) + "122222222"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("I")
    SPattern(a) = SPattern(a) + ".2222222."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + "....1...."
    SPattern(a) = SPattern(a) + ".3333333."
    a = Asc("G")
    SPattern(a) = SPattern(a) + ".11111111"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2....4444"
    SPattern(a) = SPattern(a) + "2.......5"
    SPattern(a) = SPattern(a) + "2......35"
    SPattern(a) = SPattern(a) + "2.....3.5"
    SPattern(a) = SPattern(a) + ".33333..5"
    a = Asc("Q")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2....5..4"
    SPattern(a) = SPattern(a) + "2.....5.4"
    SPattern(a) = SPattern(a) + ".2....55."
    SPattern(a) = SPattern(a) + "..33333.5"
    a = Asc("O")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("D")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1444444.."

    a = Asc("6")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2.444444."
    SPattern(a) = SPattern(a) + "24......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("H")
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "133333332"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    a = Asc("4")
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "133333332"
    SPattern(a) = SPattern(a) + "........2"
    SPattern(a) = SPattern(a) + "........2"
    SPattern(a) = SPattern(a) + "........2"
    SPattern(a) = SPattern(a) + "........2"

    a = Asc("E")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2444444.."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "233333333"
    a = Asc("N")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "12......3"
    SPattern(a) = SPattern(a) + "1.2.....3"
    SPattern(a) = SPattern(a) + "1..2....3"
    SPattern(a) = SPattern(a) + "1...2...3"
    SPattern(a) = SPattern(a) + "1....2..3"
    SPattern(a) = SPattern(a) + "1.....2.3"
    SPattern(a) = SPattern(a) + "1......23"
    SPattern(a) = SPattern(a) + "1.......3"
    a = Asc("B")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1444444.."
    a = Asc("L")
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "122222222"
    a = Asc("U")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + ".2222222."
    a = Asc("P")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("R")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1.....4.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1.......4"
End Sub

Surprised the Circle Fill routine works without the QBJS fix in it.
b = b + ...
Reply


Messages In This Thread
Fall Banner Contest? - by grymmjack - 08-30-2023, 12:22 AM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 12:26 AM
RE: Fall Banner Contest? - by bplus - 08-30-2023, 01:06 AM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 02:40 PM
RE: Fall Banner Contest? - by dbox - 08-30-2023, 01:13 AM
RE: Fall Banner Contest? - by Dav - 08-30-2023, 02:52 PM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 02:53 PM
RE: Fall Banner Contest? - by bplus - 08-30-2023, 02:54 PM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 08:41 PM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 10:56 PM
RE: Fall Banner Contest? - by TerryRitchie - 08-30-2023, 04:19 PM
RE: Fall Banner Contest? - by bplus - 08-30-2023, 05:49 PM
RE: Fall Banner Contest? - by dbox - 08-30-2023, 04:25 PM
RE: Fall Banner Contest? - by grymmjack - 08-30-2023, 10:46 PM
RE: Fall Banner Contest? - by dbox - 08-30-2023, 04:45 PM
RE: Fall Banner Contest? - by TerryRitchie - 08-30-2023, 05:07 PM
RE: Fall Banner Contest? - by dbox - 08-30-2023, 09:08 PM
RE: Fall Banner Contest? - by TerryRitchie - 08-30-2023, 09:28 PM
RE: Fall Banner Contest? - by SMcNeill - 08-31-2023, 12:30 AM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 12:53 AM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 02:27 AM
RE: Fall Banner Contest? - by Jack - 08-31-2023, 09:35 AM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 11:12 AM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 11:52 AM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 12:12 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 12:15 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 12:21 PM
RE: Fall Banner Contest? - by dbox - 08-31-2023, 12:27 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 01:03 PM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 01:22 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 03:26 PM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 02:07 PM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 07:25 PM
RE: Fall Banner Contest? - by johnno56 - 08-31-2023, 08:32 PM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 09:19 PM
RE: Fall Banner Contest? - by PhilOfPerth - 08-31-2023, 11:19 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 11:06 PM
RE: Fall Banner Contest? - by Dav - 08-31-2023, 11:19 PM
RE: Fall Banner Contest? - by bplus - 08-31-2023, 11:31 PM
RE: Fall Banner Contest? - by grymmjack - 08-31-2023, 11:53 PM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 12:08 AM
RE: Fall Banner Contest? - by grymmjack - 09-01-2023, 12:12 AM
RE: Fall Banner Contest? - by grymmjack - 09-01-2023, 12:10 AM
RE: Fall Banner Contest? - by grymmjack - 09-01-2023, 12:13 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 12:23 AM
RE: Fall Banner Contest? - by grymmjack - 09-01-2023, 12:50 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 12:30 AM
RE: Fall Banner Contest? - by grymmjack - 09-01-2023, 12:52 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 12:31 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 12:51 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 01:01 AM
RE: Fall Banner Contest? - by bplus - 09-01-2023, 01:23 AM
RE: Fall Banner Contest? - by bplus - 09-02-2023, 05:13 PM
RE: Fall Banner Contest? - by bplus - 09-02-2023, 05:25 PM
RE: Fall Banner Contest? - by grymmjack - 09-02-2023, 05:37 PM
RE: Fall Banner Contest? - by grymmjack - 09-02-2023, 05:43 PM
RE: Fall Banner Contest? - by bplus - 09-02-2023, 07:28 PM
RE: Fall Banner Contest? - by SMcNeill - 09-02-2023, 07:45 PM
RE: Fall Banner Contest? - by bplus - 09-03-2023, 06:23 PM
RE: Fall Banner Contest? - by grymmjack - 09-04-2023, 12:26 AM
RE: Fall Banner Contest? - by bplus - 10-01-2023, 03:01 PM
RE: Fall Banner Contest? - by bplus - 10-02-2023, 06:39 PM
RE: Fall Banner Contest? - by grymmjack - 10-02-2023, 07:12 PM
RE: Fall Banner Contest? - by grymmjack - 10-03-2023, 03:58 AM
RE: Fall Banner Contest? - by dbox - 10-03-2023, 11:48 AM
RE: Fall Banner Contest? - by JRace - 10-04-2023, 02:43 AM
RE: Fall Banner Contest? - by TerryRitchie - 10-04-2023, 02:49 AM
RE: Fall Banner Contest? - by JRace - 10-04-2023, 03:08 AM
RE: Fall Banner Contest? - by bplus - 10-03-2023, 12:07 PM
RE: Fall Banner Contest? - by TerryRitchie - 10-03-2023, 02:03 PM
RE: Fall Banner Contest? - by dbox - 10-03-2023, 12:55 PM
RE: Fall Banner Contest? - by SpriggsySpriggs - 10-03-2023, 01:44 PM
RE: Fall Banner Contest? - by bplus - 10-03-2023, 02:58 PM
RE: Fall Banner Contest? - by grymmjack - 10-03-2023, 11:17 PM



Users browsing this thread: 7 Guest(s)