Spring Banner Contest! (2023) - Printable Version

Code: (Select All)
Import Dom From "lib/web/dom.bas"

Const SaveTextAs256Color = 0 'Flag to Save as 256 color file or 32-bit color file, when converting SCREEN 0 to an image

'                             Set to TRUE (any non-zero value) to save text screens in 256 color mode.

'                             Set to FALSE (zero) to save text screens in 32-bit color mode.



_Title "B+ Banner Builder" ' b+ 2023-03-12

' mod 1 start banner

' mod 2 add sun and rays

' mod 3 no overlap!

' mod 4 plasma coloring? don't like random bland!

' mod 5 number of petals determines color also twirl flower petals randomly

' mod 6 more flowers!

' mod 7 clean logo both sides of title

' mod 8 new draw flower with special pallet, only one screen option now



Const XMAX = 1400 '                                                          screen banner specs

Const YMAX = 256

Const MinPetals = 4 '                                                  flower from 4 to 8 petals

Const MaxPetals = 8



Dim Shared As Object label, txtFlowers, txtTitle, lstFont, txtFontSize, txtFontWeight



Screen _NewImage(XMAX, YMAX, 32)

Randomize Timer '  oh we can have different flower arrangements



InitUI



DrawBanner



Sub DrawBanner

    Cls

    label.style.display = "none"

    '                                            color palette according to Pedals of flower  4 to 8

    ReDim pal~&(MinPetals To MaxPetals) '                                       colors in the peLogo

    pal~&(4) = _RGB32(255, 0, 0) '                                                          high red

    pal~&(5) = _RGB32(242, 94, 13) '                                                     deep orange

    pal~&(6) = _RGB32(26, 50, 230) '                                                            blue

    pal~&(7) = _RGB32(77, 161, 179) '                                                           cyan

    pal~&(8) = _RGB32(242, 175, 13) '                                                    pale orange



    Dim As Long logo, fnt, wallpaper

    Dim k$, logo, sq, i, border~&, ray, angle, n, px1, py1, colr, shift

    logo = _LoadImage("peLogo.png")

    sq = (YMAX - 140) ^ 4



    For i = 0 To 140 ' sky

        Line (0, i)-(XMAX, i), _RGB32(50 + i, 50 + i, 115 + i)

    Next

    border~& = _RGB32(255, 255, 100)

    ray = _Hypot(701, 141) '                                          longest diagonal line is this

    angle = _Pi(1 / 30) '                                    60 to a circle like minutes to a clock

    For n = -1 To 31

        px1 = 700 + ray * Cos(_Pi(1) + n * angle)

        py1 = 140 + ray * Sin(_Pi(1) + n * angle)

        Line (700, 140)-(px1, py1), border~& '                                       catch some rays

        If n > -1 Then

            px1 = 700 + .1 * ray * Cos(_Pi(1) + n * angle - .5 * angle + shift)

            py1 = 140 + .1 * ray * Sin(_Pi(1) + n * angle - .5 * angle + shift)

            If n Mod 2 Then colr = _RGB32(255, 255, 50, 45) Else colr = _RGB32(255, 255, 200, 45)

            Paint (px1, py1), colr, border~&

        End If '                                                  shade the rays for sun spectacular

    Next

    For i = 140 To YMAX ' ground

        Line (0, i)-(XMAX, i), _RGB32(0, 255 - i, 0)

    Next



    nf = txtFlowers.value '2000 ' number of flowers                                             setup and draw flowers

    ReDim fx(1 To nf), fy(1 To nf), fs(1 To nf) 'x, y size

    For i = 1 To nf

        dim ok

        Do

            ok = 1

            xoff = Rnd * XMAX

            yoff = YMAX - (Rnd * sq) ^ .25

            size = 15 * (yoff - 140) / 116

            If size < 1 Then size = 1

            For j = 1 To i - 1 '                                space out flowers less overlap!

                If _Hypot(xoff - fx(j), yoff - fy(j)) < size + fs(j) + 1 Then ok = 0: Exit For

            Next

        Loop Until ok

        fx(i) = xoff: fy(i) = yoff: fs(i) = size

        petals = Int((MaxPetals - MinPetals + 1) * Rnd) + MinPetals

        size = 15 * (yoff - 140) / 116

        If size < 1 Then size = 1

            DrawFlower xoff, yoff, petals, size, pal~&(petals)

        _Display

    Next



    _PutImage (25, 5), logo ', wallpaper

    _PutImage (_Width - 25 - _Width(logo), 5), logo ', wallpaper



    label.style.display = "block"

    label.innerHTML = txtTitle.value

    label.style.fontSize = txtFontSize.value + "px"

    label.style.fontFamily = lstFont.value '"comic sans ms, arial, helvetica, sans-serif"

    label.style.fontWeight = "normal"

    label.style.marginLeft = "-" + Fix(label.offsetWidth / 2) + "px"

End Sub



Sub DrawFlower (x, y, nPetals, radius, c~&) '  better flowers developed today 3/12/2023

    Dim roffset, pa, r, a, xx, yy

    roffset = _Pi(2) * Rnd

    pa = _Pi(2 / nPetals)

    r = .66 * radius

    For a = 0 To _Pi(2) Step pa

        xx = x + r * Cos(a + roffset)

        yy = y + r * Sin(a + roffset)

        FCirc xx, yy, radius / 2, c~&

    Next

    For a = 0 To _Pi(2) Step pa

        xx = x + radius * Cos(a + roffset + .5 * pa)

        yy = y + radius * Sin(a + roffset + .5 * pa)

        Line (xx, yy)-(x, y), _RGB32(255 - y)

    Next

    FCirc x, y, radius / 3, _RGB32(229, 242, 13) '                    fixed yellow to match Logo

End Sub



Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)

    Dim Radius As Long, RadiusError As Long

    Dim X As Long, Y As Long

    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0

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

    Line (CX - X, CY)-(CX + X, CY), C ', BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), C ', 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 InitUI

    Dim As Object panel, btn



    label = Dom.Create("div", , "")

    label.style.position = "absolute"

    label.style.color = "#fff"

    label.style.top = "0px"

    label.style.left = "50%"

    label.style.letterSpacing = "normal"

    label.style.whiteSpace = "nowrap"

    label.style.textShadow = "3px 3px rgba(0, 0, 0, .5)"



    panel = Dom.Create("div")

    panel.style.marginTop = "20px"

    panel.style.letterSpacing = "normal"

    

    Dom.Create "span", panel, "Flowers: "

    txtFlowers = Dom.Create("input", panel, "1900")

    txtFlowers.type = "number"

    txtFlowers.style.width = "75px"

    txtFlowers.style.textAlign = "right"

    

    Dom.Create "span", panel, " Title: "

    txtTitle = Dom.Create("input", panel, "QB64 Phoenix Edition")

    

    Dom.Create "span", panel, " Font: "

    lstFont = Dom.Create("select", panel)

    AddOption lstFont, "Arial (sans-serif)", "Arial, sans-serif"

    AddOption lstFont, "Impact (sans-serif)", "Impact, sans-serif"

    AddOption lstFont, "Times New Roman (serif)", "Times New Roman, serif"

    AddOption lstFont, "Georgia (serif)", "Georgia, serif"

    AddOption lstFont, "Courier (monospace)", "Courier, monospace"

    AddOption lstFont, "Lucida (monospace)", "Lucida, monospace"

    AddOption lstFont, "Brush Script MT (cursive)", "Brush Script MT, cursive"

    AddOption lstFont, "Comic Sans MS (cursive)", "Comic Sans MS, cursive"

    

    lstFontWeight = Dom.Create("select", panel)

    AddOption lstFontWeight, "100 (Lightest)", "100"

    AddOption lstFontWeight, "200", "200"

    AddOption lstFontWeight, "300", "300"

    AddOption lstFontWeight, "400 (Normal)", "400"

    AddOption lstFontWeight, "500", "500"

    AddOption lstFontWeight, "600", "600"

    AddOption lstFontWeight, "700 (Bold)", "700"

    AddOption lstFontWeight, "800", "800"

    AddOption lstFontWeight, "900 (Boldest)", "900"

    lstFontWeight.value = "400"

    

    'Dom.Create "span", panel, " Font Size: "

    txtFontSize = Dom.Create("input", panel, "75")

    txtFontSize.type = "number"

    txtFontSize.style.width = "50px"

    txtFontSize.style.textAlign = "right"

    Dom.Create "span", panel, "px "

    

    btn = Dom.Create("button", panel, "Redraw")

    btn.style.marginLeft = "10px"

    Dom.Event btn, "click", sub_DrawBanner

End Sub



Sub AddOption(list, text, value)

    Dim opt As Object

    opt = Dom.Create("option", list)

    opt.value = value

    opt.innerText = text

End Sub