03-12-2023, 08:44 PM
This might be my last qazillionth banner for this Spring, it is done!
OK for Sprezzo and QB64 purest among us:
Here is code to get colors of peLogo I used for color palette for flowers:
Here is the code that does all the drawing and save the image, thanks Steve!
Here is the whole folder with Font, Logo image and Steve's SaveImage Bi and Bm
OK for Sprezzo and QB64 purest among us:
Here is code to get colors of peLogo I used for color palette for flowers:
Code: (Select All)
_Title "Get Logo Colors" ' b+ 2023-03-12
Screen _NewImage(600, 600, 32)
_ScreenMove 300, 100
logo = _LoadImage("peLogo.png")
Do
_PutImage , logo, 0
While _MouseInput: Wend
c~& = Point(_MouseX, _MouseY)
cAnalysis c~&, red, green, blue, alph
Locate 1, 1: Print red, green, blue, alph
_Limit 60
Loop
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End SubHere is the code that does all the drawing and save the image, thanks Steve!
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'Here is the whole folder with Font, Logo image and Steve's SaveImage Bi and Bm
b = b + ...