QB64 Phoenix Edition
Dialog Tools - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Dialog Tools (/showthread.php?tid=3024)

Dialog Tools - bplus - 09-11-2024

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$("Well?", "Test call inputBox", 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$ (prompt$, title$, 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

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.

   
   

RE: Dialog Tools - Dav - 09-11-2024

Oh yes, nice.  Good one for the toolbox.

- Dav

RE: Dialog Tools - Petr - 09-11-2024

Nice work, bplus  Smile

RE: Dialog Tools - bplus - 09-11-2024

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.