Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
(03-14-2023, 11:02 PM)dbox Wrote: (03-14-2023, 08:53 PM)dbox Wrote: Have you ever thought, "Man, I wish I could make banners like bplus, but coding is hard!"
Well now you can make spring banners too with the "B+ Banner Builder"!
Try it online today:
https://qbjs.org/?src=https://raw.github...uilder.zip
Now with more font options!
bplus Wrote:LOL not exactly b+ approved but I like the hint of being legendary You are legendary sir!
That's pretty cool how you turned it into GUI and can rerun with different conditions. I wonder if we could get the part of code that spreads out the flowers working without the GoTo? Stay tuned...
I like that font.
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
03-14-2023, 11:41 PM
(This post was last modified: 03-14-2023, 11:50 PM by bplus.)
@dbox
replace:
Code: (Select All) '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
_Continue
End If
Next
with
Code: (Select All) 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
PS reset number of flowers to 1900, 2000 max!!!
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
03-14-2023, 11:58 PM
(This post was last modified: 03-15-2023, 12:04 AM by bplus.)
So here is code now QBJS:
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
Ah the centering code for title is not working either:
Can the text labels be center aligned?
b = b + ...
Posts: 159
Threads: 10
Joined: Apr 2022
Reputation:
32
Nice bplus! I’ll incorporate your changes and check out the text alignment when I can get back in front of a computer.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
03-15-2023, 12:36 AM
(This post was last modified: 03-15-2023, 12:41 AM by bplus.)
OK I tried running the code I posted and errors???
Here is the Share Code from QBJS site:
https://qbjs.org/?code=SW1wb3J0IERvbSBGc...C+QNCekAlA==
Dang! Same problem again! ??
I am substituting the code for the Goto loop and then I am changing 2000 for number of flowers to 1900 so you aren't waiting 3-5 minutes for screen to fill with that many less overlapping flowers.
b = b + ...
Posts: 159
Threads: 10
Joined: Apr 2022
Reputation:
32
Hey bplus, it’s due to the logo file not being there. In my original example, I was referencing a zip file that has the code and logo file. If you drag that logo file into the Files tab in qbjs it should work.
Once you do that you can use the save button to create a project zip that has all of the files needed.
Posts: 249
Threads: 9
Joined: Apr 2022
Reputation:
4
all this bp logos are great but my is natural
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation:
47
(03-14-2023, 11:58 PM)bplus Wrote: Can the text labels be center aligned?
Must do it to a monospaced font. Trying to do it to a "conventional" font is a PITA. Must get the font widths of every single alphabet glyph, uppercase and lowercase in the least and do a smart computation out of it. I don't know, might be enough to sum the widths for a given phrase, divide by two and then take it from half the screen width? I'm not familiar anymore with the frequent text-centering algorithm.
Posts: 159
Threads: 10
Joined: Apr 2022
Reputation:
32
Hey @bplus, I've updated the sample with the improved flower spacing code you provided:
https://qbjs.org/?src=https://raw.github...uilder.zip
I think the text centering issue may be due to the fact that it is using an html overlay for the text. If you are viewing it with the IDE code panel still visible it could throw off the alignment. You can try minimizing the code panel with minimize / maximize buttons between the code and preview panels here:
Or you can use the "play" mode link to just go straight to the program without the IDE showing at all:
https://qbjs.org/?mode=play&src=https://raw.githubusercontent.com/boxgaming/qbjs/main/samples/project/bplus-banner-builder.zip
It seems to be centered when I try it:
Let me know if that doesn't work for you. (As an aside I'm planning to add support for _Font and _LoadFont to the next QBJS release.)
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
(03-15-2023, 12:28 PM)mnrvovrfc Wrote: (03-14-2023, 11:58 PM)bplus Wrote: Can the text labels be center aligned?
Must do it to a monospaced font. Trying to do it to a "conventional" font is a PITA. Must get the font widths of every single alphabet glyph, uppercase and lowercase in the least and do a smart computation out of it. I don't know, might be enough to sum the widths for a given phrase, divide by two and then take it from half the screen width? I'm not familiar anymore with the frequent text-centering algorithm.
That's the hard way. In QB64 you get the width of a string in pixels with _PrintWidth(myString$) and center it on pixel width of screen or pixel width of box area for label. But QBJS does not have all QB64 functions. It does have GUI though, thanks to dbox most recent mod one of my banners!
b = b + ...
|