Spring Banner Contest! (2023) - Printable Version

Code: (Select All)
'$INCLUDE:'SaveImage.BI'



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+ Spring Banner 8, space to take snap" ' 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



'                                            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



Screen _NewImage(XMAX, YMAX, 32)

_ScreenMove 0, 100

Randomize Timer '  oh we can have different flower arrangements



Dim As Long logo, fnt, wallpaper

Dim k$

ReDim savefile As String

savefile = "Spring Banner 8 by b+.png"

logo = _LoadImage("peLogo.png")

fnt = _LoadFont("ARLRDBD.TTF", 100)

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 = 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

    tryAgain:

    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 GoTo tryAgain

    Next

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

    _Title "B+ Spring Banner 8, spacebar to take snap after beep. Flowers:" + Str$(i)

    k$ = InKey$

    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

Beep

wallpaper = _NewImage(XMAX, YMAX, 32)

_PutImage , 0, wallpaper

_Font fnt, wallpaper

_PrintMode _KeepBackground , wallpaper

_Dest wallpaper

_PutImage (25, 5), logo, wallpaper

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

_Dest wallpaper

Color _RGB32(255, 255, 255)

s$ = "QB64 Phoenix Edition"

_PrintString ((_Width - _PrintWidth(s$)) / 2, 20), s$, wallpaper

_Dest 0



Dim result '                                                                    save image or NOT

While _KeyDown(27) = 0 ' <<<<<<<<<<<<< allow escape from screen

    _PutImage , wallpaper&, 0

    k$ = InKey$

    _Display

    If k$ = " " Then

        result = SaveImage(savefile, 0, 0, 0, _Width - 1, _Height - 1)

        If result = 1 Then 'file already found on drive

            Kill savefile 'delete the old file

            result = SaveImage(savefile, 0, 0, 0, _Width - 1, _Height - 1) 'save the new one again

        End If

        If result >= 0 Then Cls: Print "Save Failed": Beep: End ' <<<<<<<<<<<<<<<<<  beep = failed

    ElseIf Len(k$) Then

        Exit While

    End If

    _Display

    _Limit 60

Wend



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

    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



'$INCLUDE:'SaveImage.BM'