Posts: 2,458
Threads: 248
Joined: Apr 2022
Reputation:
125
02-18-2025, 12:46 AM
(This post was last modified: 02-18-2025, 12:47 AM by Pete.)
Yeah, but yours needs to run in a graphics screen, which makes it very hard to keep your lunch down. 
Shoot first and shoot people who ask questions, later.
Posts: 4,129
Threads: 185
Joined: Apr 2022
Reputation:
242
You shouldn't be eating my lunch anyway!
b = b + ...
Posts: 2,458
Threads: 248
Joined: Apr 2022
Reputation:
125
02-18-2025, 01:24 AM
(This post was last modified: 02-18-2025, 07:25 AM by Pete.)
Okay, just for fun, here is my lib cut down to a single button type, with no built in demo. Much fewer lines, of course...
Code: (Select All)
_Title "Roll The Dice by SierraKen"
Dim As Single lb, mb, rb, mw, my, mx
ReDim Shared fld$(0), button$(0), mRow$(0)
ReDim Shared x(0), y(0), y1(0), y2(0), x1(0), x2(0), fnx(0), btnmap(0), FType(0)
Type fields_and_buttons
a As String
initiate As Integer
fld As Integer
nof As Integer
nob As Integer
style As Integer
BSelect As Integer
Bg As Integer ' Begin button colors.
BBdr As Integer
BBdrHover As Integer
BBdrFlash As Integer
BFg As Integer
BBg As Integer
BBg1 As Integer
BHvrFg As Integer
BHvrBk As Integer
End Type
Dim fb As fields_and_buttons
fb.BBdr = 8: fb.BBdrHover = 1: fb.BBdrFlash = 9: fb.BFg = 15: fb.BBg = 3: fb.BBg1 = 1: fb.BHvrFg = 3: fb.BHvrBk = 1: fb.Bg = 5
Palette 5, 63
Palette 7, 63
Color 0, 7: Cls
Randomize Timer
Do
Do
defaultInput$ = " "
msg$ = "How many sides is your dice (3-100)?": GoSub myinput
If _Trim$(result$) = "" Then End
num = Val(result$)
If num < 3 Or num > 100 Or num <> Int(num) Then
msg$ = "Pick only between 3 and 100.": GoSub pete
Exit Do
End If
dice = Int(Rnd * num) + 1
dice$ = Str$(dice)
msg$ = "Your roll: " + dice$: GoSub pete
Loop
Loop
myinput:
result$ = ""
popup 3, 3, 8, 62 ' Top, Left, Height, Width
Locate 4, 5: Print msg$;
Color 15, 0
Locate 6, 5: Print Chr$(221) + Space$(34) + Chr$(222);
Locate 6, 6, 1, 7, 7
fb.a = " OK ": fb_text_buttons fb, 4, 51
fb.a = " Cancel ": fb_text_buttons fb, 7, 51
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
fb_main fb, button$(), mx, my, lb
If b$ >= "0" And b$ <= "9" Or b$ = Chr$(8) Then
If Left$(result$, 1) = "0" And b$ <> Chr$(8) Or Len(result$) = 3 And b$ <> Chr$(8) Then b$ = ""
If b$ = Chr$(8) Then
If Len(result$) > 0 Then
result$ = Mid$(result$, 1, Len(result$) - 1)
Locate , Pos(0) - 1: Print " ";: Locate , Pos(0) - 1
End If
Else
Print b$;
result$ = result$ + b$
End If
End If
If fb.BSelect Or b$ = Chr$(13) And Len(result$) Then Exit Do
Loop
If fb.BSelect = 2 Then System
GoSub renew
Return
pete:
popup 6, 19, 9, 32 ' Top, Left, Height, Width.
Locate 7, 19 - 1 + (32 - Len(msg$)) \ 2, 0: Print msg$;
fb.a = " OK ": fb_text_buttons fb, 10, 30
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
fb_main fb, button$(), mx, my, lb
If fb.BSelect Or b$ = Chr$(13) Then Exit Do
Loop
GoSub renew
renew:
_AutoDisplay
PCopy 1, 0
Palette 7, 63
fb.initiate = 0: fb.nof = 0
ReDim fld$(0), button$(0), mRow$(0)
ReDim x(0), y(0), y1(0), y2(0), x1(0), x2(0), fnx(0), btnmap(0), FType(0)
Return
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)
Dim As Integer oldmw
Static As Integer oldmy, oldmx, mwy, oldmwy
Static z1 As Single
_Limit 60
If AltStatus% Then AltStatus% = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Exit Sub
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
AltStatus% = -1
AltToggle% = 1 - AltToggle%
Exit Sub
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
oldmy = my: oldmx = mx
End Sub
Sub fb_main (fb As fields_and_buttons, button$(), mx, my, lb)
Static prev_fld
s1 = CsrLin: s2 = Pos(0)
b_hover = 0: fb.fld = 0: fb.BSelect = 0
For i = 1 To fb.nof ' number of fields.
If my >= y1(i) And my <= y2(i) And mx >= x1(i) And mx <= x2(i) Then
fb.fld = i
b_hover = btnmap(fb.fld)
Exit For
End If
Next
If prev_fld And prev_fld <> fb.fld Then ' Remove button hover effect when present.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
i = prev_fld
j = Len(button$(btnmap(i)))
Color fb.BBdr, fb.Bg
Locate y1(i), x1(i): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(i): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(i): Print Chr$(192) + String$(j, 196) + Chr$(217);
prev_fld = 0
force = -1 ' Local variable to force any tab button field to remain highlighted.
Color c1, c2
Locate s1, s2
End If
If b_hover Then ' Add hover effect.
prev_fld = fb.fld
h = lb
q = fb.fld
l = b_hover
Select Case h
Case 0, -1, 1 ' Static or color change if button clicked.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(l))
If Abs(h) = 1 Then Color fb.BBdrFlash, fb.Bg Else Color fb.BBdrHover, fb.Bg
Locate y1(q), x1(q): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(q): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(q): Print Chr$(192) + String$(j, 196) + Chr$(217);
Color c1, c2
Locate s1, s2
Case 2 ' Button selection completed.
fb.BSelect = l
End Select
End If
Locate s1, s2
_Display
End Sub
Sub fb_text_buttons (fb As fields_and_buttons, y, x)
Static btnnbr
If fb.initiate = 0 Then
fb.initiate = 1
btnnbr = 0
End If
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(fb.a)
fb.nof = fb.nof + 1: fb.nob = fb.nob + 1
ReDim _Preserve fld$(fb.nof), FType(fb.nof), btnmap(fb.nof)
FType(fb.nof) = 5
btnnbr = btnnbr + 1
btnmap(fb.nof) = btnnbr
fld$(fb.nof) = Space$(25)
ReDim _Preserve y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), button$(fb.nof)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) \ 2) = _Trim$(fb.a)
Color fb.BBdr, fb.Bg
Locate y - 1, x - 1: fb.a = Chr$(218) + String$(j, 196) + Chr$(191): fb_map fb, 6
Locate y, x - 1: fb.a = Chr$(179): fb_map fb, 0
Locate , Pos(0) + j: fb.a = Chr$(179): fb_map fb, 0
Locate y + 1, x - 1: fb.a = Chr$(192) + String$(j, 196) + Chr$(217): fb_map fb, 7
Locate y, x: fb.a = button$(btnnbr): fb_map fb, 0
Color c1, c2
Locate s1, s2
End Sub
Sub fb_map (fb As fields_and_buttons, mapid)
Static mapfld As Integer
If UBound(mRow$) = 0 Then
ReDim mRow$(_Height)
mapfld = 96
End If
Select Case mapid
Case 6 ' Text or hybrid button top.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin: x1(mapfld - 96) = Pos(0)
Case 7 ' Text or hybrid button bottom.
y2(mapfld - 96) = CsrLin: x2(mapfld - 96) = Pos(0) + Len(fb.a)
End Select
Print fb.a;
End Sub
Sub popup (m.top, m.left, m.height, m.width)
pop = 1
c.MenuBdrFg = 0
c.MenubrdBg = 5
c.MenuSdwFg = 6
c.MenuSdwBg = 0
c.MenuFg = 0
c.MenuBg = 5
spacing = 1
PCopy 0, 1
Palette 7, 7
Palette 6, 58
Locate m.top - pop, m.left - pop
For h = 1 To m.height
If h = 1 Then
Color c.MenuBdrFg, c.MenubrdBg
Print Chr$(218) + String$(m.width - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To m.height - 2
If CsrLin < _Height Then Locate j, m.left - pop Else Locate , m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
Color c.MenuBdrFg, c.MenubrdBg: Print Space$(m.width - 2);
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(192) + String$(m.width - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color c.MenuSdwFg, c.MenuSdwBg ' Shadow below.
Locate CsrLin + 1, m.left - pop + 2
For i = 1 To m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate m.top - pop + 1 ' Shadow to the right.
For i = 1 To m.height - 1
Locate , m.left - pop + m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color c.MenuFg, c.MenuBg
Locate m.top - pop + h + (h - 1) * spacing, m.left - pop + 2 - 1
Next h
End Sub
I removed the tab feature, as it also added quite a few extra lines. This one has the input box as well.
Pete
Posts: 559
Threads: 97
Joined: Apr 2022
Reputation:
45
02-18-2025, 08:43 PM
(This post was last modified: 02-18-2025, 08:44 PM by SierraKen.)
ROFL Awesome guys, I'm glad you had some fun with it.
After Steve said the boxes are easy, I've been racking my brain for hours last night and this morning just to make 3 boxes, moveable by the mouse. I made it last night, except, I think there's a sequence problem because sometimes a box, that I'm not using, will overlap onto another box. Oh sure, sounds simple... until I've tried almost everything in the book that I know how to do. lol
Here is what I have if you want to check it out. This is the simple version from last night. I'm sure I have to double the box drawings to make all 6 possibilities of 3 boxes. But the problem is, when and how... lol. I've tried arrays and 3 different variables, and 3 different variable arrays.. until my head exploded. lol
Here is your mission if you choose to accept it....
Code: (Select All)
Screen _NewImage(800, 600, 32)
x1 = 400: y1 = 300
x2 = 0: y2 = 0
x3 = 600: y3 = 400
click = 1
click2 = 1
'Box 1 Text
a1$ = "Hello"
let1 = Len(a1$)
pix1 = let1 * 8
'Box 2 Text
a2$ = "QB64 Phoenix Edition"
let2 = Len(a2$)
pix2 = let2 * 8
'Box 3 Text
a3$ = "Forum!"
let3 = Len(a3$)
pix3 = let3 * 8
_Title "Moveable Boxes Example - Use Mouse"
Do
_Limit 30
While _MouseInput
If _MouseButton(1) Then
x = _MouseX
y = _MouseY
If x > x1 And x < x1 + 200 And y > y1 And y < y1 + 200 And click <> 2 And click <> 3 Then
x1 = x - 100
y1 = y - 100
click = 1
click2 = 1
End If
If x > x2 And x < x2 + 200 And y > y2 And y < y2 + 200 And click <> 1 And click <> 3 Then
x2 = x - 100
y2 = y - 100
click = 2
click2 = 2
End If
If x > x3 And x < x3 + 200 And y > y3 And y < y3 + 200 And click <> 1 And click <> 2 Then
x3 = x - 100
y3 = y - 100
click = 3
click2 = 3
End If
Else
click = 0
End If
Wend
If click = 1 Or click2 = 1 Then
'Box 2
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(100, 100, 200), BF
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(100, 100, 200)
cent2 = (x2 + 100) - (pix2 / 2)
_PrintString (cent2, y2 + 100), a2$
'Box 3
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(200, 200, 100), BF
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(200, 200, 100)
cent3 = (x3 + 100) - (pix3 / 2)
_PrintString (cent3, y3 + 100), a3$
'Box 1
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 100, 100), BF
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(255, 100, 100)
cent1 = (x1 + 100) - (pix1 / 2)
_PrintString (cent1, y1 + 100), a1$
End If
If click = 2 Or click2 = 2 Then
'Box 3
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(200, 200, 100), BF
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(200, 200, 100)
cent3 = (x3 + 100) - (pix3 / 2)
_PrintString (cent3, y3 + 100), a3$
'Box 1
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 100, 100), BF
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(255, 100, 100)
cent1 = (x1 + 100) - (pix1 / 2)
_PrintString (cent1, y1 + 100), a1$
'Box 2
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(100, 100, 200), BF
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(100, 100, 200)
cent2 = (x2 + 100) - (pix2 / 2)
_PrintString (cent2, y2 + 100), a2$
End If
If click = 3 Or click2 = 3 Then
'Box 1
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 100, 100), BF
Line (x1, y1)-(x1 + 200, y1 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(255, 100, 100)
cent1 = (x1 + 100) - (pix1 / 2)
_PrintString (cent1, y1 + 100), a1$
'Box 2
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(100, 100, 200), BF
Line (x2, y2)-(x2 + 200, y2 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(100, 100, 200)
cent2 = (x2 + 100) - (pix2 / 2)
_PrintString (cent2, y2 + 100), a2$
'Box 3
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(200, 200, 100), BF
Line (x3, y3)-(x3 + 200, y3 + 200), _RGB32(255, 255, 255), B
Color _RGB32(255, 255, 255), _RGB32(200, 200, 100)
cent3 = (x3 + 100) - (pix3 / 2)
_PrintString (cent3, y3 + 100), a3$
End If
_Display
Line (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
If InKey$ = Chr$(27) Then Exit Do
Loop
Posts: 4,129
Threads: 185
Joined: Apr 2022
Reputation:
242
+1 nice work!
b = b + ...
Posts: 1
Threads: 0
Joined: Feb 2025
Reputation:
0
(02-15-2025, 11:58 PM)Hey SierraKen! ? Wrote: This is a really cool and simple way to showcase the new InputBox$ and MessageBox features in QB64pe! ? I like how you’ve structured it to handle invalid inputs gracefully—nothing worse than breaking a program with unexpected input!
I remember playing around with GUI frameworks in QB64 a while back too, and it’s interesting to think about how they’ve evolved. Have you considered adding an option to roll multiple dice at once or maybe a simple log to track past rolls? That could be a fun addition!
Great job on this—thanks for sharing! Looking forward to seeing what you build next. ?? [quote pid="32093" dateline="1739663938"]
[/quote]
Posts: 559
Threads: 97
Joined: Apr 2022
Reputation:
45
9 hours ago
(This post was last modified: 9 hours ago by SierraKen.)
Thanks @emmasPPM ! Those are some good ideas, I might look into it, thank you. If you want to see more of my apps that I've made, I have a little section on this forum, if you haven't seen it yet. It's here:
https://qb64phoenix.com/forum/forumdisplay.php?fid=62
Posts: 559
Threads: 97
Joined: Apr 2022
Reputation:
45
Using EmmasPPM's ideas to make more than 1 round and to keep a log of them, here is an updated version. Thanks Emmas!
The limit on rounds is 100, then it will tell you the limit has been reached.
Code: (Select All)
'Roll The Dice v.2
'Feb. 19, 2025
'Thank you to EmmasPPM for the ideas to make more than 1 round and to keep a log of the rounds.
Dim dice(100)
Dim a$(100)
Dim totals(100)
_Title "Roll The Dice by SierraKen"
Randomize Timer
Do
Do
'How many dice.
title$ = "Roll The Dice"
defaultInput$ = " "
message$ = "How many dice do you wish to roll (1-100)?"
result$ = _InputBox$(title$, message$, defaultInput$)
If _Trim$(result$) = "" Then End
diceam = Val(result$)
If diceam < 1 Or diceam > 100 Or diceam <> Int(diceam) Then
_MessageBox "Roll The Dice", "Pick only between 1 and 100."
Exit Do
End If
'How many sides.
title$ = "How many sides."
defaultInput$ = " "
message$ = "How many sides is your dice (3-100)?"
result$ = _InputBox$(title$, message$, defaultInput$)
If _Trim$(result$) = "" Then End
num = Val(result$)
If num < 3 Or num > 100 Or num <> Int(num) Then
_MessageBox "How many sides.", "Pick only between 3 and 100."
Exit Do
End If
'Roll The Dice
For t = 1 To diceam
dice(t) = Int(Rnd * num) + 1
a$(t) = Str$(dice(t))
b$ = b$ + " [ Dice " + Str$(t) + ": " + a$(t) + " ] "
total = total + dice(t)
Next t
m$ = b$ + " [ Roll Total: " + Str$(total) + " ]"
_MessageBox "Roll The Dice", m$
'Round Totals Window
rounds = rounds + 1
totals(rounds) = total
For r = 1 To rounds
r$ = r$ + " [ Round " + Str$(r) + ": " + Str$(totals(r)) + " ] "
Next r
_MessageBox "Dice Round Totals Log", r$
If rounds = 100 Then
_MessageBox "Limit Reached", "Your 100 round limit has been reached, feel free to play again."
End
End If
'Clear strings and variable for next round.
m$ = ""
a$ = ""
b$ = ""
r$ = ""
total = 0
Loop
Loop
|
Roll The Dice InputBox$ and MessageBox Example
