+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Buttons and Boxes (/showthread.php?tid=1214)
Buttons and Boxes - James D Jarvis - 12-01-2022
A simple control and display scheme for text mode. Currently only supports one active dialog at a time.
Has a number of built-in styles.
Use the mouse or the up and down arrow keys to make a selection.
Code: (Select All)
'Buttons_N_Boxes
'by James D. Jarvis, December 2022
'this demo shows a couple subroutines for simple text boxes and selection boxes in text mode
'if you can read this code and have QB64 you are of course perfectly welcome to use it as you wish.
'
'currently supports just one active button dialog ( Button box) at a time.
'$dynamic
Screen _NewImage(80, 30, 0)
_Title "Buttons and Boxes"
'------------------------------------------------------
'header must be included to use these subroutines
'------------------------------------------------------
Dim Shared bchar$(15, 9)
buildbchar
'------------------------------------------------------
'demo code
'------------------------------------------------------
Randomize Timer
Dim bb$(7)
Dim ob$(1)
bb$(1) = "One": bb$(2) = "Two": bb$(3) = "Three": bb$(4) = "Four"
bb$(5) = "Five": bb$(6) = "Six": bb$(7) = "Seven"
demotext$ = "Please make a selection."
bpick = buttonbox(11, 2, 60, 10, 5, bb$(), demotext$)
Locate 1, 1
If bpick > 0 Then
mtext$ = "You selected button " + bb$(bpick)
Else
mtext$ = "No option selected"
End If
Cls
ob$(1) = "OKAY"
bpick = buttonbox(3, 3, 32, 5, 1, ob$(), mtext$)
ReDim bb$(2)
bb$(1) = "YES": bb$(2) = "QUIT"
bpick = buttonbox(5, 4, 32, 5, 1, bb$(), "Want to see a bunch of Printboxes?")
If bpick = 1 Then
Cls
demotext$ = "The quick brown fox took a ride on the cow as it jumped over the moon and the owl found out how many licks it took to get to the center of a tootsie pop."
Randomize Timer
For n = 1 To 30
boxX = Int(1 + Rnd * 60): boxY = Int(1 + Rnd * 20)
boxW = Int(12 + Rnd * 30): boxH = Int(3 + Rnd * 9)
bstyle = Int(1 + Rnd * 15)
bklr = Int(Rnd * 16) - 8: If bklr < 0 Then bklr = 0
Do
fklr = Int(Rnd * 20): If fklr > 15 Then fklr = 15
Loop Until fklr <> bklr
Color fklr, bklr
printbox boxX, boxY, boxW, boxH, bstyle, demotext$
_Delay 0.5
Next n
Color 15, 0
printbox 11, 8, 60, 4, 1, "That's it, a nice simple demonstration of PRINTBOX"
printbox 11, 12, 60, 4, 5, "Text is clipped to fit the printbox. While text will wrap within the box any extra characters will be lost."
ob$(1) = "QUIT"
dummy = buttonbox(11, 16, 60, 3, 7, ob$(), "BYE")
End If
System
'------------------------------------------------------
' Printbox draws a fixed text box for a text mode screem
' there are 15 styles programmed into this.
' Each is defined by a string array where corners, top and sides are defined in bchar$
'
'text will wrap inside the print box butwill not printoutside the printbox, that would be another subroutine
'the box may screen wrap the text will not.
'------------------------------------------------------
Sub printbox (bx, by, ww, hh, bb, txt$)
topbar$ = bchar$(bb, 1) + String$(ww - 2, Asc(bchar$(bb, 2))) + bchar$(bb, 3)
midbar$ = bchar$(bb, 4) + String$(ww - 2, Asc(bchar$(bb, 5))) + bchar$(bb, 6)
btmbar$ = bchar$(bb, 7) + String$(ww - 2, Asc(bchar$(bb, 8))) + bchar$(bb, 9)
_PrintString (bx, by), topbar$
For r = 1 To hh - 2: _PrintString (bx, by + r), midbar$: Next r
_PrintString (bx, by + hh - 1), btmbar$
ml = Len(txt$)
If ml < ww - 2 Then
cx = bx + ww / 2 - ml \ 2
_PrintString (cx, by + 1), txt$
Else
cx = bx + 2
cy = by + 1
For c = 1 To ml
If cy < _Height - 1 And cx < _Width - 1 Then
If cy < (by + hh - 1) Then _PrintString (cx, cy), Mid$(txt$, c, 1)
End If
cx = cx + 1
If cx > bx + ww - 3 Or cx > _Width - 1 Then
cx = bx + 2
cy = cy + 1
End If
Next c
End If
End Sub
Sub buildbchar
bchar$(1, 1) = Chr$(219): bchar$(1, 2) = Chr$(223): bchar$(1, 3) = Chr$(219)
bchar$(1, 4) = Chr$(219): bchar$(1, 5) = Chr$(32): bchar$(1, 6) = Chr$(219)
bchar$(1, 7) = Chr$(219): bchar$(1, 8) = Chr$(220): bchar$(1, 9) = Chr$(219)
bchar$(2, 1) = Chr$(178): bchar$(2, 2) = Chr$(178): bchar$(2, 3) = Chr$(178)
bchar$(2, 4) = Chr$(178): bchar$(2, 5) = Chr$(32): bchar$(2, 6) = Chr$(178)
bchar$(2, 7) = Chr$(178): bchar$(2, 8) = Chr$(178): bchar$(2, 9) = Chr$(178)
bchar$(3, 1) = Chr$(177): bchar$(3, 2) = Chr$(177): bchar$(3, 3) = Chr$(177)
bchar$(3, 4) = Chr$(177): bchar$(3, 5) = Chr$(32): bchar$(3, 6) = Chr$(177)
bchar$(3, 7) = Chr$(177): bchar$(3, 8) = Chr$(177): bchar$(3, 9) = Chr$(177)
bchar$(4, 1) = Chr$(176): bchar$(4, 2) = Chr$(176): bchar$(4, 3) = Chr$(176)
bchar$(4, 4) = Chr$(176): bchar$(4, 5) = Chr$(32): bchar$(4, 6) = Chr$(176)
bchar$(4, 7) = Chr$(176): bchar$(4, 8) = Chr$(176): bchar$(4, 9) = Chr$(176)
bchar$(5, 1) = Chr$(218): bchar$(5, 2) = Chr$(196): bchar$(5, 3) = Chr$(191)
bchar$(5, 4) = Chr$(179): bchar$(5, 5) = Chr$(32): bchar$(5, 6) = Chr$(179)
bchar$(5, 7) = Chr$(192): bchar$(5, 8) = Chr$(196): bchar$(5, 9) = Chr$(217)
bchar$(6, 1) = Chr$(213): bchar$(6, 2) = Chr$(205): bchar$(6, 3) = Chr$(184)
bchar$(6, 4) = Chr$(179): bchar$(6, 5) = Chr$(32): bchar$(6, 6) = Chr$(179)
bchar$(6, 7) = Chr$(212): bchar$(6, 8) = Chr$(205): bchar$(6, 9) = Chr$(190)
bchar$(7, 1) = Chr$(201): bchar$(7, 2) = Chr$(205): bchar$(7, 3) = Chr$(187)
bchar$(7, 4) = Chr$(186): bchar$(7, 5) = Chr$(32): bchar$(7, 6) = Chr$(186)
bchar$(7, 7) = Chr$(200): bchar$(7, 8) = Chr$(205): bchar$(7, 9) = Chr$(188)
bchar$(8, 1) = Chr$(219): bchar$(8, 2) = Chr$(196): bchar$(8, 3) = Chr$(219)
bchar$(8, 4) = Chr$(179): bchar$(8, 5) = Chr$(32): bchar$(8, 6) = Chr$(179)
bchar$(8, 7) = Chr$(219): bchar$(8, 8) = Chr$(196): bchar$(8, 9) = Chr$(219)
bchar$(9, 1) = Chr$(219): bchar$(9, 2) = Chr$(42): bchar$(9, 3) = Chr$(219)
bchar$(9, 4) = Chr$(42): bchar$(9, 5) = Chr$(32): bchar$(9, 6) = Chr$(42)
bchar$(9, 7) = Chr$(219): bchar$(9, 8) = Chr$(42): bchar$(9, 9) = Chr$(219)
bchar$(10, 1) = Chr$(42): bchar$(10, 2) = Chr$(42): bchar$(10, 3) = Chr$(42)
bchar$(10, 4) = Chr$(42): bchar$(10, 5) = Chr$(32): bchar$(10, 6) = Chr$(42)
bchar$(10, 7) = Chr$(42): bchar$(10, 8) = Chr$(42): bchar$(10, 9) = Chr$(42)
bchar$(11, 1) = Chr$(240): bchar$(11, 2) = Chr$(240): bchar$(11, 3) = Chr$(240)
bchar$(11, 4) = Chr$(240): bchar$(11, 5) = Chr$(32): bchar$(11, 6) = Chr$(240)
bchar$(11, 7) = Chr$(240): bchar$(11, 8) = Chr$(240): bchar$(11, 9) = Chr$(240)
bchar$(12, 1) = Chr$(240): bchar$(12, 2) = Chr$(240): bchar$(12, 3) = Chr$(240)
bchar$(12, 4) = Chr$(32): bchar$(12, 5) = Chr$(32): bchar$(12, 6) = Chr$(32)
bchar$(12, 7) = Chr$(240): bchar$(12, 8) = Chr$(240): bchar$(12, 9) = Chr$(240)
bchar$(13, 1) = Chr$(240): bchar$(13, 2) = Chr$(240): bchar$(13, 3) = Chr$(240)
bchar$(13, 4) = Chr$(46): bchar$(13, 5) = Chr$(46): bchar$(13, 6) = Chr$(46)
bchar$(13, 7) = Chr$(240): bchar$(13, 8) = Chr$(240): bchar$(13, 9) = Chr$(240)
bchar$(14, 1) = Chr$(46): bchar$(14, 2) = Chr$(46): bchar$(14, 3) = Chr$(46)
bchar$(14, 4) = Chr$(46): bchar$(14, 5) = Chr$(46): bchar$(14, 6) = Chr$(46)
bchar$(14, 7) = Chr$(46): bchar$(14, 8) = Chr$(46): bchar$(14, 9) = Chr$(46)
bchar$(15, 1) = Chr$(176): bchar$(15, 2) = Chr$(176): bchar$(15, 3) = Chr$(176)
bchar$(15, 4) = Chr$(176): bchar$(15, 5) = Chr$(176): bchar$(15, 6) = Chr$(176)
bchar$(15, 7) = Chr$(176): bchar$(15, 8) = Chr$(176): bchar$(15, 9) = Chr$(176)
End Sub
'-----------------------------------------------------------
'Button box
'uses pritnbox to display a an array of bottons passed in the array btn$()
'the id number of the button selected is returned
'if <esc> is used bypass the selection a value of 0 is returned.
'make selection with a mouse or using the up and down arrow keys with <return>
'-----------------------------------------------------------
Function buttonbox (bx, by, ww, hh, bb, btn$(), txt$)
bi& = _NewImage(_Width + 1, _Height + 1, 256)
ds& = _Dest
bcount = UBound(btn$)
fk = _DefaultColor
thh = hh
tnh = Len(txt$) / (ww - 3)
If tnh < 1 Then tnh = 1
bby = by + tnh + 2
If thh < bby + bcount * 3 Then thh = tnh + bcount * 3 + 4
printbox bx, by, ww, thh, bb, txt$
For b = 1 To bcount
printbox bx + 2, bby, ww - 4, 3, bb, btn$(b)
_Dest bi&
Line (bx + 2, bby)-(bx + ww - 4, bby + 2), b, BF
_Dest ds&
bby = bby + 3
Next b
bselect = 0
Do
_Limit 60
bkk = _KeyHit
Select Case bkk
Case -18432 'up
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
bselect = bselect - 1
If bselect < 1 Then bselect = bcount
btpy = by + tnh + 2 + (bselect - 1) * 3
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
Case -20480 'down
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
bselect = bselect + 1
If bselect > bcount Then bselect = 1
btpy = by + tnh + 2 + (bselect - 1) * 3
fk = _DefaultColor
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
End Select
lasto = 0
Do While _MouseInput
_Source bi&
pbx = _MouseX
pby = _MouseY
optt = Point(pbx, pby)
If optt > 0 And bptt < bcount + 1 Then
If lasto <> optt And lasto > 0 Then
Color fk
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(lasto)
End If
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
Color fk
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
Color fk + 16
btpy = by + tnh + 2 + (optt - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(optt)
Color fk
lasto = optt
If optt > 0 Then bselect = optt
End If
If _MouseButton(1) Then
Do
_Limit 60
i = _MouseInput
Loop Until Not _MouseButton(1)
pbx = _MouseX
pby = _MouseY
bptt = Point(pbx, pby)
Locate 1, 4: Print bptt
End If
If bptt > 0 And bptt < bcount + 1 Then
btpy = by + tnh + 2 + (bptt - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bptt)
bselect = bptt
btpy = by + tnh + 2 + (bselect - 1) * 3
fk = _DefaultColor
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
_Delay 0.05
bkk = -13
GoTo mdone
End If
Loop
mdone:
Loop Until bkk = -27 Or bkk = -13
Locate 2, 2: Print bselect
_Dest ds&
_Source ds&
_FreeImage bi&
buttonbox = bselect
End Function