(02-17-2025, 08:18 PM)SMcNeill Wrote: These boxes are so simple, just make your own.
Yeah piece of cake
Code: (Select All)
_Title "Roll The Dice by SierraKen mod by b+"
Screen _NewImage(800, 600, 32): _ScreenMove 250, 60 ' sorry Ken this needs graphics screen
Randomize Timer
Do
Do
title$ = "Roll The Dice"
message$ = "(Nothing quits) How many sides is your dice (3-100)?"
result$ = inputBox$(message$, title$, 60) ' sorry I should have put title$ first!
If _Trim$(result$) = "" Then End
num = Val(result$)
If num < 3 Or num > 100 Or num <> Int(num) Then
mBox "Roll The Dice", "Pick only between 3 and 100."
Exit Do
End If
dice = Int(Rnd * num) + 1
dice$ = Str$(dice)
mBox "Shake, rattle and...", "Your roll: " + dice$
Loop
Loop
' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
Function inputBox$ (prompt$, title$, boxWidth As _Byte)
Dim ForeColor As _Unsigned Long, BackColor As _Unsigned Long
Dim sw As Long, sh As Long, curScrn As Long, backScrn As Long, ibx As Long 'some handles
'colors
ForeColor = &HFF000055 '< change as desired prompt text color, back color or type in area
BackColor = &HFF6080CC '< change as desired used fore color in type in area
'items to restore at exit
ScnState 0
'screen snapshot
sw = _Width: sh = _Height: curScrn = _Dest
backScrn = _NewImage(sw, sh, 32)
_PutImage , curScrn, backScrn
'moving box around on screen
Dim bxW As Long, bxH As Long
Dim mb As Long, mx As Long, my As Long, mi As Long, grabx As Long, graby As Long
Dim tlx As Long, tly As Long 'top left corner of message box
Dim lastx As Long, lasty As Long
Dim inp$, kh&
'draw message box
bxW = boxWidth * 8: bxH = 7 * 16
ibx = _NewImage(bxW, bxH, 32)
_Dest ibx
Color &HFF880000, &HFFFFFFFF
Locate 1, 1: Print Left$(Space$(Int((boxWidth - Len(title$) - 3)) / 2) + title$ + Space$(boxWidth), boxWidth)
Color &HFFFFFFFF, &HFFBB0000
Locate 1, boxWidth - 2: Print " X "
Color ForeColor, BackColor
Locate 2, 1: Print Space$(boxWidth);
Locate 3, 1: Print Left$(Space$((boxWidth - Len(prompt$)) / 2) + prompt$ + Space$(boxWidth), boxWidth);
Locate 4, 1: Print Space$(boxWidth);
Locate 5, 1: Print Space$(boxWidth);
Locate 6, 1: Print Space$(boxWidth);
inp$ = ""
GoSub finishBox
'convert to pixels the top left corner of box at moment
bxW = boxWidth * 8: bxH = 5 * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
_KeyClear
'now allow user to move it around or just read it
While 1
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
_Display
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
If mx >= tlx + bxW - 24 Then Exit While
grabx = mx - tlx: graby = my - tly
Do While mb 'wait for release
mi = _MouseInput: mb = _MouseButton(1)
mx = _MouseX: my = _MouseY
If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
'attempt to speed up with less updates
If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
tlx = mx - grabx: tly = my - graby
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
lastx = tlx: lasty = tly
_Display
End If
End If
_Limit 400
Loop
End If
End If
kh& = _KeyHit
Select Case kh& 'whew not much for the main event!
Case 13: Exit While
Case 27: inp$ = "": Exit While
Case 32 To 128: If Len(inp$) < boxWidth - 4 Then inp$ = inp$ + Chr$(kh&): GoSub finishBox Else Beep
Case 8: If Len(inp$) Then inp$ = Left$(inp$, Len(inp$) - 1): GoSub finishBox Else Beep
End Select
_Limit 60
Wend
'put things back
ScnState 1 'need fg and bg colors set to cls
Cls '? is this needed YES!!
_PutImage , backScrn
_Display
_FreeImage backScrn
_FreeImage ibx
ScnState 1 'because we have to call _display, we have to call this again
inputBox$ = inp$
Exit Function
finishBox:
_Dest ibx
Color BackColor, ForeColor
Locate 5, 2: Print Left$(" " + inp$ + Space$(boxWidth - 2), boxWidth - 2)
_Dest curScrn
Return
End Function
' needs to run in a graphics screen
'title$ limit is 57 chars, all lines are 58 chars max, version 2019-08-06
'THIS SUB NOW NEEDS SUB scnState(restoreTF) for saving and restoring screen settings
Sub mBox (title As String, m As String)
Dim bg As _Unsigned Long, fg As _Unsigned Long
bg = &HFF404040
fg = &HFF33AAFF
'first screen dimensions and items to restore at exit
Dim sw As Long, sh As Long
Dim curScrn As Long, backScrn As Long, mbx As Long 'some handles
Dim ti As Long, limit As Long 'ti = text index for t$(), limit is number of chars per line
Dim i As Long, j As Long, ff As _Bit, addb As _Byte 'index, flag and
Dim bxH As Long, bxW As Long 'first as cells then as pixels
Dim mb As Long, mx As Long, my As Long, mi As Long, grabx As Long, graby As Long
Dim tlx As Long, tly As Long 'top left corner of message box
Dim lastx As Long, lasty As Long, t As String, b As String, c As String, tail As String
Dim d As String, r As Single, kh As Long
'screen and current settings to restore at end ofsub
ScnState 0
sw = _Width: sh = _Height
_KeyClear '<<<<<<<<<<<<<<<<<<<< do i still need this? YES! 2019-08-06 update!
'screen snapshot
curScrn = _Dest
backScrn = _NewImage(sw, sh, 32)
_PutImage , curScrn, backScrn
'setup t() to store strings with ti as index, linit 58 chars per line max, b is for build
ReDim t(0) As String: ti = 0: limit = 58: b = ""
For i = 1 To Len(m)
c = Mid$(m, i, 1)
'are there any new line signals, CR, LF or both? take CRLF or LFCR as one break but dbl LF or CR means blank line
Select Case c
Case Chr$(13) 'load line
If Mid$(m, i + 1, 1) = Chr$(10) Then i = i + 1
t(ti) = b: b = "": ti = ti + 1: ReDim _Preserve t(ti) As String
Case Chr$(10)
If Mid$(m, i + 1, 1) = Chr$(13) Then i = i + 1
t(ti) = b: b = "": ti = ti + 1: ReDim _Preserve t(ti)
Case Else
If c = Chr$(9) Then c = Space$(4): addb = 4 Else addb = 1
If Len(b) + addb > limit Then
tail = "": ff = 0
For j = Len(b) To 1 Step -1 'backup until find a space, save the tail end for next line
d = Mid$(b, j, 1)
If d = " " Then
t(ti) = Mid$(b, 1, j - 1): b = tail + c: ti = ti + 1: ReDim _Preserve t(ti)
ff = 1 'found space flag
Exit For
Else
tail = d + tail 'the tail grows!
End If
Next
If ff = 0 Then 'no break? OK
t(ti) = b: b = c: ti = ti + 1: ReDim _Preserve t(ti)
End If
Else
b = b + c 'just keep building the line
End If
End Select
Next
t(ti) = b
bxH = ti + 3: bxW = limit + 2
'draw message box
mbx = _NewImage(60 * 8, (bxH + 1) * 16, 32)
_Dest mbx
Color _RGB32(128, 0, 0), _RGB32(225, 225, 255)
Locate 1, 1: Print Left$(Space$((bxW - Len(title) - 3) / 2) + title + Space$(bxW), bxW)
Color _RGB32(225, 225, 255), _RGB32(200, 0, 0)
Locate 1, bxW - 2: Print " X "
Color fg, bg
Locate 2, 1: Print Space$(bxW);
For r = 0 To ti
Locate 1 + r + 2, 1: Print Left$(" " + t(r) + Space$(bxW), bxW);
Next
Locate 1 + bxH, 1: Print Space$(limit + 2);
'now for the action
_Dest curScrn
'convert to pixels the top left corner of box at moment
bxW = bxW * 8: bxH = bxH * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
'now allow user to move it around or just read it
While 1
Cls
_PutImage , backScrn
_PutImage (tlx, tly), mbx, curScrn
_Display
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
If mx >= tlx + bxW - 24 Then Exit While
grabx = mx - tlx: graby = my - tly
Do While mb 'wait for release
mi = _MouseInput: mb = _MouseButton(1)
mx = _MouseX: my = _MouseY
If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
'attempt to speed up with less updates
If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
tlx = mx - grabx: tly = my - graby
Cls
_PutImage , backScrn
_PutImage (tlx, tly), mbx, curScrn
lastx = tlx: lasty = tly
_Display
End If
End If
_Limit 400
Loop
End If
End If
kh = _KeyHit
If kh = 27 Or kh = 13 Or kh = 32 Then Exit While
_Limit 400
Wend
'put things back
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0): Cls '
_PutImage , backScrn
_Display
_FreeImage backScrn
_FreeImage mbx
ScnState 1 'Thanks Steve McNeill
End Sub
' ============================================================= This is old version dev for mBox or InputBox new version dev with new GetArrayItem$
' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static defaultColor~&, backGroundColor~&
Static font&, dest&, source&, row&, col&, autodisplay&, mb&
If restoreTF Then
_Font font&
Color defaultColor~&, backGroundColor~&
_Dest dest&
_Source source&
Locate row&, col&
If autodisplay& Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb& = _MouseButton(1)
If mb& Then
Do
While _MouseInput: Wend
mb& = _MouseButton(1)
_Limit 100
Loop Until mb& = 0
End If
Else
font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
dest& = _Dest: source& = _Source
row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
_KeyClear
End If
End SubHa, ha @Pete mine is only 294 lines
PLUS I can drag both boxes by their title bar.
b = b + ...