Dialog Tools

[bplus]

Thanks to Petr and Dav for informing that _InputBox has problems, I didn't realize.

So now I will bring my inputBox$ Function out of retirement:

Code: (Select All)

Option _Explicit
_Title "inputBox$ tester.bas started 2018-10-26 need an input box for WS Editor"
' 2019-07-32 assimulate scnState(restoreTF) used to save and restore screen settings
' so sub can do it's thing and restore settings, Thanks Steve McNeill for starter code and idea.

Screen _NewImage(800, 600, 32)
_ScreenMove 100, 20
Dim well$, enter$, k$, kh As Long

Color &HFFFFFF00, &HFF880000
Print "Here is some stuff on screen. Press h or m for inputBox$"
'well$ = inputBox$("Well?", "Test inputBox$", 20)
'Print "inputBox$ returned: "; well$; ". Is this line printing exactly below last stuff sentence?" ' OK now with center fix too!
'Input "OK? enter for next test, use h or m keypress to invoke inputBox$...", enter$

'draw stuff, until h or m press, then show message box
While 1
    k$ = InKey$
    If k$ = "m" Or k$ = "h" Then
        well$ = inputBox$("Test call inputBox", "Well?", 36)
        Print "inputBox$() returned: *"; well$; "*"
    End If
    'kh = 0  'should not need this to stop esc keypress in input box
    Line (Rnd * _Width, Rnd * (_Height - 20) + 20)-Step(Rnd * 80, Rnd * 60), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
    kh = _KeyHit
    If kh = 27 Then Exit While
    '_DISPLAY   '<< should not need this
    _Limit 5
Wend
Print "OK where is this print line going to end up, hopefully under the last inputBox returned." 'yes! Excellent!
Print "InputBox$() last returned: "; well$; ",  Goodbye!"
End

' 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$ (title$, prompt$, boxWidth As _Byte)
    Dim ForeColor As _Unsigned Long, BackColor As _Unsigned Long, White As _Unsigned Long
    Dim sw As Integer, sh As Integer, 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
    White = &HFFFFFFFF

    '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 Integer, bxH As Integer
    Dim mb As Integer, mx As Integer, my As Integer, mi As Integer, grabx As Integer, graby As Integer
    Dim tlx As Integer, tly As Integer 'top left corner of message box
    Dim lastx As Integer, lasty As Integer
    Dim inp$, kh&

    'draw message box
    bxW = boxWidth * 8: bxH = 7 * 16
    ibx = _NewImage(bxW, bxH, 32)
    _Dest ibx
    Color &HFF880000, White
    Locate 1, 1: Print Left$(Space$(Int((boxWidth - Len(title$) - 3)) / 2) + title$ + Space$(boxWidth), boxWidth)
    Color White, &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

'from mBox v 2019-07-31 update
' for saving and restoring screen settins
Sub scnState (restoreTF As Integer) 'Thanks Steve McNeill
    Static Font As Long, DefaultColor As _Unsigned Long, BackGroundColor As _Unsigned Long, Dest As Long, Source As Long
    Static row As Integer, col As Integer, autodisplay As Integer, mb As Integer
    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
    End If
End Sub

Edit: 2025-02-17 I switched places with title$ and prompt to match other InputBoxes and MessageBoxes.

This is small one-liner INPUT you can use for getting info from user without ruining the screen.

You can grab the title bar and drag it all over the screen if it happens to be sitting right on top of something you need to see to answer the InputBox inquiry.

   
   

[Dav]

Oh yes, nice.  Good one for the toolbox.

- Dav

[Petr]

Nice work, bplus 

[bplus]

Thanks guys, it's been around for going on 6 years. Steve's suggestion for ScreenState routine for saving and restoring screen conditions allowed me to drop allot of redundant code for Dialogs.

[bplus]

For those of you who can do without hearing the Windows chime

mBox (MessageBox) demo

Code: (Select All)

_Title "mBox (messageBox) Demo, press m or h for mBox... esc to quit"
Screen _NewImage(800, 600, 32): _ScreenMove 250, 60
While 1
    k$ = InKey$
    If k$ = "m" Or k$ = "h" Then
        mBox "mBox Demo", "Hello World!" + Chr$(10) + "This is a sample message for mBox. Try dragging my Title bar around."
    End If
    'kh = 0  'should not need this to stop esc keypress in input box
    Line (Rnd * _Width, Rnd * (_Height - 20) + 20)-Step(Rnd * 80, Rnd * 60), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
    kh = _KeyHit
    If kh = 27 Then Exit While
    '_DISPLAY   '<< should not need this
    _Limit 5
Wend
Print "OK this print line should be first line in graphics screen."
mBox "End of Demo", "Goodbye!"


' 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 Sub