Very Simple GUI

[vince]

wow nice, this is becoming the phoenix edition of inform

[bplus]

I've made over the GUI Get Filename app with the revised controls and made it even more handy as a practical application by adding the pathed filenames to the clipboard for pasting in where needed or for a list of pathed filenames delimited by chr$(10) for a mass file thing.

Here is the file listing of the zip off the clipboard from running this app:

C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI Makeover June 27-2022\Makeover GetFilename/arial.ttf
C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI Makeover June 27-2022\Makeover GetFilename/ARLRDBD.TTF
C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI Makeover June 27-2022\Makeover GetFilename/FreeSansBold.ttf
C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI Makeover June 27-2022\Makeover GetFilename/GUI Makeover Get Filename.bas

The first 3 files are fonts it uses and the 4th is bas source, no BI or BM yet still changing their contents.

Here is the new look:
   

The zip has been updated with fixed DrwBtn and Button colors reversed to show off new draw of buttons.

[Kernelpanic]

It looks now really elegant. 

Only the Red Color I don't think it fits. How would be that, or something like that. - Maybe a little darker.

[bplus]

Oh wow, found a major goof with DrwBtn messing with colors, this fixes that and a reversal of dark and light for button coloring:

Code: (Select All)

Option _Explicit
_Title "GUI Makeover Get Filename" 'b+ 2022-07-02 test new control changes

'    DO NOT Put more than one item in a List Box for text val, because the control LstCon needs to be split by same delimiter


'''$include:'vs GUI.BI'

'==================================================================================================================  vs GUI.BI start

' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< see b+ Very Simple GUI.txt file end
Declare CustomType Library ".\direntry"
    Function load_dir& (s As String)
    Function has_next_entry& ()
    Sub close_dir ()
    Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare

'reset your Default colors here   FC = ForeColor  BC = Back Color  All the RGB32() are right here in constants section!
Dim Shared As _Unsigned Long Black, White, screenBC, BtnFC, BtnBC, TbFC, TbBC, LstFC, LstBC, LblFC
Black = _RGB32(0, 0, 0)
White = _RGB32(255, 255, 255)
screenBC = _RGB32(160, 160, 255)
BtnFC = _RGB32(0, 0, 0)
BtnBC = _RGB32(250, 250, 250)
TbFC = _RGB32(180, 180, 255)
TbBC = _RGB32(0, 0, 128)
LstFC = _RGB32(255, 180, 180)
LstBC = _RGB32(190, 0, 0)
LblFC = _RGB32(0, 0, 68)

Type Control ' all are boxes with colors, 1 is active
    As Long ConType, X, Y, W, H, FontH, TabStop, Hide, N1, N2, N3, N4, N5, N6, FHdl ' N1, N2 sometimes controls need extra numbers for special functions
    As String Text, Text2, ImgFile, FontFile ' dims are pixels  Text2 is for future selected text from list box
    As _Unsigned Long FC, BC
End Type
Dim Shared GuiTitle$ ' WindowOpen
Dim Shared curPath$ ' _CWD$ in OpenWindow for file stuff
Dim Shared As Long Xmax, Ymax, NControls, ActiveControl
ReDim Shared con(0) As Control

'Dim Shared fontHandle&(6 To 128) ' more range? to 128 set in OpenWindow

'================================================================================================================== vs GUI.BI end

'   Set Globals from BI
Xmax = 1280: Ymax = 720: GuiTitle$ = "GUI Makeover Get Filename" ' <<<<<  Window size shared throughout program
OpenWindow Xmax, Ymax, GuiTitle$ ' need to do this before drawing anything from NewControls

' GUI Controls
'                     Dim and set Globals for GUI app
Dim Shared As Long lblPath, lblCurPath, lblDirs, LblFils, lstD, lstF, lblFile, lblSelFile
Dim Shared As Long BtnOk, BtnSetClip, BtnAddClip, BtnCancel, BtnKill
'' Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long,_
''  FontH As Long, ForeC As Long, BackC As Long, TStop As Long, Hide As Long, s$, Imgfile$, fontFile$) ' dims are pixels 2nd line is new stuff
'              type, x, y, w, h, font h, FC, BC, TStop, Hide, text, imgFile, FontFile )

Dim fils$, dirs$
GetListStrings dirs$, fils$

lblPath = NewControl(4, 0, 10, _Width - 1, 20, 20, 899, 0, -1, 0, "Current Folder:", "", "ARLRDBD.ttf")
lblCurPath = NewControl(4, 0, 35, _Width, 20, 16, 2, 0, -1, 0, curPath$, "", "ARLRDBD.ttf")
lblDirs = NewControl(4, 150, 60, 300, 20, 20, 899, 0, -1, 0, "Sub Directories:", "", "ARLRDBD.ttf")
LblFils = NewControl(4, 530, 60, 600, 20, 20, 899, 0, -1, 0, "Files:", "", "ARLRDBD.ttf")

lstD = NewControl(3, 150, 85, 300, 502, 20, 3, 669, -1, 0, dirs$, "", "arial.ttf")
lstF = NewControl(3, 530, 85, 600, 502, 20, 3, 779, -1, 0, fils$, "", "arial.ttf")

lblFile = NewControl(4, 0, 590, _Width - 1, 20, 20, 899, 0, -1, 0, "Selected File:", "", "ARLRDBD.ttf")
lblSelFile = NewControl(4, 0, 620, _Width - 1, 20, 16, 2, 0, -1, 0, "Selected File goes here", "", "ARLRDBD.ttf")

BtnOk = NewControl(1, 20, 650, 232, 50, 24, 500, 889, -1, 0, "Run It", "", "FreeSansBold.ttf")
BtnSetClip = NewControl(1, 272, 650, 232, 50, 24, 500, 889, -1, 0, "Clipboard It", "", "FreeSansBold.ttf")
BtnAddClip = NewControl(1, 524, 650, 232, 50, 24, 500, 889, -1, 0, "Add It To Clip", "", "FreeSansBold.ttf")
BtnCancel = NewControl(1, 776, 650, 232, 50, 24, 500, 889, -1, 0, "Quit", "", "FreeSansBold.ttf")
BtnKill = NewControl(1, 1028, 650, 232, 50, 24, 500, 889, -1, 0, "Kill It!", "", "FreeSansBold.ttf")
' End GUI Controls

MainRouter ' after all controls setup

'  EDIT these to your programs needs
Sub BtnClickEvent (i As Long) ' attach you button click code in here
    Dim answer$, dirs$, fils$ ' <<<<<<<<<<<<<<<<<< dim for click code
    Select Case i
        Case BtnOk: Shell _DontWait con(lblSelFile).Text ' hey run it!
        Case BtnSetClip: _Clipboard$ = con(lblSelFile).Text
        Case BtnAddClip: _Clipboard$ = _Clipboard$ + Chr$(10) + con(lblSelFile).Text
        Case BtnKill
            answer$ = inputBox$(con(lblSelFile).Text, "Confirm Kill, enter y or n", _Width \ 8 - 7)
            If answer$ = "y" Then
                Kill con(lblSelFile).Text
                GetListStrings dirs$, fils$
                con(lstD).Text = dirs$
                con(lstF).Text = fils$
                con(lblSelFile).Text = ""
                drwLbl lblSelFile
                drwLst lstD, 0
                drwLst lstF, 0
            End If
        Case BtnCancel: System ' goodbye
    End Select
End Sub

Sub LstSelectEvent (control As Long)
    Dim fils$, dirs$
    Select Case control
        Case lstD
            ChDir con(lstD).Text2
            curPath$ = _CWD$
            con(lblCurPath).Text = curPath$
            drwLbl lblCurPath
            GetListStrings dirs$, fils$
            con(lstD).Text = dirs$
            con(lstF).Text = fils$
            con(lblSelFile).Text = ""
            drwLbl lblSelFile
            drwLst lstD, 0
            drwLst lstF, -1 'should be active
        Case lstF
            con(lblSelFile).Text = curPath$ + "/" + con(lstF).Text2
            drwLbl lblSelFile
    End Select
End Sub

Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long) ' attach your Picture click code in here
    Select Case i
    End Select
End Sub

Sub PicFrameUpdate (i As Long) ' attach your Picture click code in here
    Select Case i
    End Select
End Sub

''''$include:'vs GUI.BM'

'================================================================================================================== vs GUI.BM start to end
Sub MainRouter
    Dim As Long kh, mx, my, mb1, mb2, i, shift, lc, xx, yy, curPos ' lc is loop counter
    Do
        ' mouse clicks and tabs will decide the active control
        While _MouseInput
            If con(ActiveControl).ConType = 3 Then
                If _MouseWheel > 0 Then
                    LstKeyEvent ActiveControl, 20480
                ElseIf _MouseWheel < 0 Then
                    LstKeyEvent ActiveControl, 18432
                End If
            End If
        Wend
        mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
        'Line (0, 0)-Step(100, 16), screenBC, BF ' <<< for form designer show where mouse is
        'Color White
        'Locate 1, 1: Print mx; ","; my ' <<< for form designer  show where mouse is
        If mb1 Then ' find which control
            For i = 1 To NControls
                If mx >= con(i).X And mx <= con(i).X + con(i).W Then
                    If my >= con(i).Y And my <= con(i).Y + con(i).H Then
                        xx = mx - con(i).X: yy = my - con(i).Y
                        If con(i).ConType = 5 Then PicClickEvent i, xx, yy 'picture box click event
                        If i <> ActiveControl And con(i).ConType <> 4 Then
                            activateControl ActiveControl, 0
                            ActiveControl = i
                            activateControl ActiveControl, -1
                        End If
                        Exit For
                    End If
                End If
            Next
            If con(ActiveControl).ConType = 1 Then
                BtnClickEvent ActiveControl
                shiftActiveControl 1

                'Text Boxes  N1 sets cursor location !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ElseIf con(ActiveControl).ConType = 2 Then ' move cursor to click point
                If mx > con(ActiveControl).X + 4 And mx < con(ActiveControl).X + con(ActiveControl).W - 9 Then
                    If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).H Then
                        ' dont even try to align cursor! JUST PUT IT IN THE TEXT BOX
                        '  con(ActiveControl).N1 = (mx - con(ActiveControl).X + 4) / 8 '   +4 ??? fixed better not perfect
                        drwTB ActiveControl, -1
                    End If
                End If
                ' Fix !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

            ElseIf con(ActiveControl).ConType = 3 Then
                If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).FontH Then ' top empty
                    If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'home else pgUp
                        LstKeyEvent ActiveControl, 18176 ' home
                    ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
                        LstKeyEvent ActiveControl, 18688 ' pgup
                    End If
                ElseIf my >= con(ActiveControl).Y + con(ActiveControl).H - con(ActiveControl).FontH And my <= con(ActiveControl).Y + con(ActiveControl).H Then
                    ' bottom empty pgdn
                    If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'end else pgDn
                        LstKeyEvent ActiveControl, 20224 ' end
                    ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
                        LstKeyEvent ActiveControl, 20736 ' pgdn
                    End If
                ElseIf my >= con(ActiveControl).Y + con(ActiveControl).FontH And my < con(ActiveControl).Y + con(ActiveControl).H - con(ActiveControl).FontH Then
                    con(ActiveControl).N2 = Int((my - con(ActiveControl).Y - con(ActiveControl).FontH) / con(ActiveControl).FontH) + 1
                    drwLst ActiveControl, -1
                End If
            End If
            _Delay .2 ' user release key wait
        End If
        If mb2 Then ' use right clicking to select
            If con(ActiveControl).ConType = 3 Then ' this does not make the lst active but if is can select the highlited

                ' OK mBox "Debug", "Active Control:" + con(ActiveControl).Text  = activeControl = 5 and correct Text is showing

                ReDim lst(1 To 1) As String 'need to find select = text2 and select number in list = N6
                Split con(ActiveControl).Text, "~", lst()
                con(ActiveControl).N6 = (con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2
                con(ActiveControl).Text2 = lst(con(ActiveControl).N6)

                LstSelectEvent ActiveControl ' check event called for 5
                shiftActiveControl 1
                _Delay .2
            End If
        End If
        kh = _KeyHit
        shift = _KeyDown(100304) Or _KeyDown(100303)
        If kh = 9 Then 'tab
            If shift Then
                shiftActiveControl -1
            Else
                shiftActiveControl 1
            End If
        ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
            BtnClickEvent ActiveControl
            shiftActiveControl 1
        ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then
            shiftActiveControl 1
        ElseIf kh = 13 And con(ActiveControl).ConType = 3 Then
            ReDim lst(1 To 1) As String
            Split con(ActiveControl).Text, "~", lst()
            con(ActiveControl).N6 = (con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2
            con(ActiveControl).Text2 = lst(con(ActiveControl).N6)
            LstSelectEvent ActiveControl
            shiftActiveControl 1
        End If

        ' Text Box !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! is this part of problem? Contains Cursor instructions
        If con(ActiveControl).ConType = 2 Then
            TBKeyEvent ActiveControl, kh, shift ' this handles keypress in active textbox
            ' where is the cursor?
            curPos = con(ActiveControl).X + 4 + _PrintWidth(Mid$(con(ActiveControl).Text, 1, con(ActiveControl).N1 - 1))

            If lc Mod 50 = 49 Then con(ActiveControl).N2 = 1 - con(ActiveControl).N2 ' this is for blinking cursor
            If con(ActiveControl).N2 Then
                Line (curPos, con(ActiveControl).Y + (con(ActiveControl).H - con(ActiveControl).FontH) / 2 + con(ActiveControl).FontH)-Step(con(ActiveControl).N4, 1), con(ActiveControl).FC, BF
            Else
                Line (curPos, con(ActiveControl).Y + (con(ActiveControl).H - con(ActiveControl).FontH) / 2 + con(ActiveControl).FontH)-Step(con(ActiveControl).N4, 1), con(ActiveControl).BC, BF
            End If
            '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ' drwTB ActiveControl, -1


        ElseIf con(ActiveControl).ConType = 3 Then
            LstKeyEvent ActiveControl, kh
        End If
        For i = 1 To NControls ' update active picture boxes
            If con(i).ConType = 5 Then
                PicFrameUpdate i
            End If
        Next
        _Display
        lc = lc + 1
        _Limit 60
    Loop
    System
End Sub

Sub shiftActiveControl (change As Long) ' change = 1 or -1
    activateControl ActiveControl, 0 ' turn off last
    Do
        ActiveControl = ActiveControl + change
        If ActiveControl > NControls Then ActiveControl = 1
        If ActiveControl < 1 Then ActiveControl = NControls
    Loop Until con(ActiveControl).ConType <> 4
    activateControl ActiveControl, -1 ' turn on next
End Sub

Sub activateControl (i, activate)
    Select Case con(i).ConType
        Case 1: drwBtn i, activate
        Case 2: drwTB i, activate
        Case 3: drwLst i, activate
        Case 5: drwPic i, activate
    End Select
End Sub

Sub OpenWindow (WinWidth As Long, WinHeight As Long, title$) ' new set font file and handles
    Dim As Long j
    Screen _NewImage(WinWidth, WinHeight, 32)
    _ScreenMove 70, 10
    _PrintMode _KeepBackground
    _Title title$
    curPath$ = _CWD$ ' might need this for file stuff
    'For j = 6 To 128
    '    fontHandle&(j) = _LoadFont("ARLRDBD.ttf", j) ' good one!
    '    'fontHandle&(j) = _LoadFont("consola.ttf", j) ' Sucks!!!  why are these printing so close and into top line?
    '    'fontHandle&(j) = _LoadFont("FreeSansBold.ttf", j) ' ditto Sucks!!!
    '    'fontHandle&(j) = _LoadFont("Arial.ttf", j) ' good one!
    '    If fontHandle&(j) <= 0 Then
    '        Print "Loading Font error," + Str$(j) + " font height did not load. Goodbye!": End
    '    End If
    'Next
    Color White, screenBC
    Cls
End Sub

Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long,_
FontH As Long, ForeC As Long, BackC As Long, TStop As Long, Hide As Long, s$, imgFile$, fontFile$) ' dims are pixels 2nd line is new stuff
    Dim As Long a
    NControls = NControls + 1
    ReDim _Preserve con(0 To NControls) As Control
    If ConType < 1 Or ConType > 5 Then
        Beep: Print "Must specify conType 1 to 5": End
    Else
        con(NControls).ConType = ConType
    End If

    con(NControls).X = X
    con(NControls).Y = Y
    If W < 20 Then con(NControls).W = 20 Else con(NControls).W = W
    If H < 20 Then con(NControls).H = 20 Else con(NControls).H = H

    con(NControls).TabStop = TStop
    con(NControls).Hide = Hide
    con(NControls).Text = s$
    'ActiveControl = 1
    'If NControls = 1 Then a = 1 Else a = 0
    a = 0 ' for now
    Select Case ConType
        Case 1
            If FontH <= H - 4 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 4
            ' get font handle
            If fontFile$ <> "" Then
                con(NControls).FHdl = _LoadFont(fontFile$, con(NControls).FontH)
                If con(NControls).FHdl <= 0 Then
                    Print "Loading Font error," + fontFile$ + " at font height:" + Str$(con(NControls).FontH) + " did not load. Goodbye!": End
                End If
            End If
            If ForeC = 0 Then con(NControls).FC = BtnFC Else con(NControls).FC = c3I~&(ForeC)
            If BackC = 0 Then con(NControls).BC = BtnBC Else con(NControls).BC = c3I~&(BackC)
            If imgFile$ <> "" Then
                If Right$(LCase$(imgFile$), 4) = ".png" Or Right$(LCase$(imgFile$), 4) = ".jpg" Then 'is image file
                    If _FileExists(imgFile$) Then
                        con(NControls).N1 = _LoadImage(imgFile$)
                        If con(NControls).N1 >= 0 Then
                            Print "Error: " + imgFile$ + " image did not load, goodbye!": End
                        End If
                    Else
                        Print "Error: " + imgFile$ + " not found, goodbye!": End
                    End If
                Else
                    Print "Error: " + imgFile$ + " not .png, goodbye!": End
                End If
            Else
                con(NControls).N1 = 0 ' make sure to zero out all controls that will be checked!!!!!!!!!!!!!!!!!!!!!!!
            End If
            drwBtn NControls, a
        Case 2
            If FontH <= H - 8 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 8
            If fontFile$ <> "" Then
                con(NControls).FHdl = _LoadFont(fontFile$, con(NControls).FontH)
                If con(NControls).FHdl <= 0 Then
                    Print "Loading Font error," + fontFile$ + " at font height:" + Str$(con(NControls).FontH) + " did not load. Goodbye!": End
                End If
            End If

            If ForeC = 0 Then con(NControls).FC = TbFC Else con(NControls).FC = c3I~&(ForeC)
            If BackC = 0 Then con(NControls).BC = TbBC Else con(NControls).BC = c3I~&(BackC)
            con(NControls).N2 = 0
            ' set n3 the maxCursor in characters
            con(NControls).N3 = (W - FontH) \ (.6 * FontH) 'FontH is too safe leaves half the box empty! try .7 still pretty safe
            con(NControls).Text = Mid$(s$, 1, con(NControls).N3)
            If Len(s$) > con(NControls).N3 Then
                Beep
                mBox "Warning:", "Text Box text has been shortened from: " + s$ + ", to " + con(NControls).Text
            End If
            con(NControls).N4 = .5 * FontH ' cursor width? one less calc when go to blink cursor
            ' N1 is what letter position we are on or cursor for line, N2 is the toggle for cursor blinking
            con(NControls).N1 = 1
            drwTB NControls, a

        Case 3
            con(NControls).FontH = FontH ' should check between 6 and 128
            If fontFile$ <> "" Then
                con(NControls).FHdl = _LoadFont(fontFile$, con(NControls).FontH)
                If con(NControls).FHdl <= 0 Then
                    Print "Loading Font error," + fontFile$ + " at font height:" + Str$(con(NControls).FontH) + " did not load. Goodbye!": End
                End If
            End If

            If ForeC = 0 Then con(NControls).FC = LstFC Else con(NControls).FC = c3I~&(ForeC)
            'mBox "yellow", Hex$(con(NControls).FC)
            If BackC = 0 Then con(NControls).BC = LstBC Else con(NControls).BC = c3I~&(BackC)
            con(NControls).N3 = Int((W - FontH) / (.5 * FontH)) ' page width - .5 charcter margin on each side 1 char scroll click bar
            con(NControls).N4 = Int((H - 2 * FontH) / FontH) ' page height 2 empty lines for page up, page down clicking
            con(NControls).N1 = 1 ' page number
            con(NControls).N2 = 1 ' select highlite bar
            con(NControls).Text2 = "" ' zero everything out for UDT's
            con(NControls).N2 = 0
            drwLst NControls, a
        Case 4
            If ForeC = 0 Then con(NControls).FC = LblFC Else con(NControls).FC = c3I~&(ForeC)
            If BackC = 0 Then con(NControls).BC = screenBC Else con(NControls).BC = c3I~&(BackC)
            If FontH <= H Then con(NControls).FontH = FontH Else con(NControls).FontH = H
            If fontFile$ <> "" Then
                con(NControls).FHdl = _LoadFont(fontFile$, con(NControls).FontH)
                If con(NControls).FHdl <= 0 Then
                    Print "Loading Font error," + fontFile$ + " at font height:" + Str$(con(NControls).FontH) + " did not load. Goodbye!": End
                End If
            End If

            'mBox "lbl fontH", Str$(con(NControls).FontH)
            drwLbl NControls
        Case 5
            If FontH <= H - 2 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 2
            If fontFile$ <> "" Then
                con(NControls).FHdl = _LoadFont(fontFile$, con(NControls).FontH)
                If con(NControls).FHdl <= 0 Then
                    Print "Loading Font error," + fontFile$ + " at font height:" + Str$(con(NControls).FontH) + " did not load. Goodbye!": End
                End If
            End If

            con(NControls).N1 = _NewImage(con(NControls).W, con(NControls).H, 32)
            _Dest con(NControls).N1
            Line (0, 0)-Step(con(NControls).W - 1, con(NControls).H - 1), Black, BF
            _Dest 0
            drwPic NControls, a
    End Select
    NewControl& = NControls ' same as ID
End Function

Function c3S~& (digit3$) ' parameter as a string of 3 digits
    Dim s3$
    Dim As Long r, g, b
    s3$ = Right$("000" + digit3$, 3)
    r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
    g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
    b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
    c3S~& = _RGB32(r, g, b)
End Function

' not used in this app but is c3s~& partner in Coloring from 3 digits
Function c3I~& (i As Long) 'parameter as an integer up 0-999 noi red until 3rd digit!
    Dim s3$
    Dim As Long r, g, b
    'mBox "c3~& input i", Str$(i)
    s3$ = Right$("000" + _Trim$(Str$(i)), 3)
    'mBox "3 digit check", s3$
    r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
    g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
    b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
    c3I~& = _RGB32(r, g, b)
End Function

Sub drwBtn (i As Long, active As Long) ' gray back, black text
    If con(i).Hide Then Exit Sub
    If con(i).N1 < 0 Then ' needs < 0 image file hndles are < 0   ' FIX? make sure N1 is set to 0 if no image file!!!!
        _PutImage (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).N1, 0
    Else ' normal button
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
        Color con(i).FC
        _Font con(i).FHdl
        'mBox "Five", Str$(_FontHeight(fontHandle&(con(i).FontH)))
        _PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y + .5 * (con(i).H - con(i).FontH) + 2), con(i).Text
    End If
    ' buttons never stay active so show them always ready to press ie up
    'light and shadow stick out
    Line (con(i).X, con(i).Y)-Step(con(i).W, 0), &H99FFFFFF
    Line (con(i).X, con(i).Y)-Step(0, con(i).H), &H99FFFFFF
    Line (con(i).X, con(i).Y + con(i).H)-Step(con(i).W, 0), Black ' base line same as highlighter when active
    Line (con(i).X + con(i).W, con(i).Y)-Step(0, con(i).H), Black ' side line ditto
End Sub

Sub drwTB (i As Long, active As Long) ' blue back, white text
    If con(i).Hide Then Exit Sub
    Dim s$, sl As Long, x As Long
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF

    Color con(i).FC
    _Font con(i).FHdl
    _PrintString (con(i).X + 4, con(i).Y + (con(i).H - con(i).FontH) / 2 + 2), con(i).Text
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    Else
        'light and shadow
        Line (con(i).X, con(i).Y)-Step(con(i).W - 1, 0), Black
        Line (con(i).X, con(i).Y)-Step(0, con(i).H), Black
        Line (con(i).X + 1, con(i).Y + con(i).H)-Step(con(i).W - 1, 0), &H99FFFFFF 'a little glare?
        Line (con(i).X + con(i).W, con(i).Y + 1)-Step(0, con(i).H - 1), &H99FFFFFF
    End If
End Sub

Sub drwLst (i As Long, active As Long)
    If con(i).Hide Then Exit Sub
    ' new control will get numbers for constructing a screen
    ' N1 = page number we are on
    ' N2 = current location of the highlight bar on the page
    ' N3 = page width in chars
    ' N4 = page height + 2 lines are left blank at top and bottom
    ' N5 = Ubound of the list() base 1 ie last item number
    Dim s$
    Dim As Long j
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF

    Line (con(i).X, con(i).Y)-Step(con(i).W - 1, 0), Black
    Line (con(i).X, con(i).Y)-Step(0, con(i).H), Black
    Line (con(i).X + 1, con(i).Y + con(i).H)-Step(con(i).W - 1, 0), &H99FFFFFF 'a little glare?
    Line (con(i).X + con(i).W, con(i).Y + 1)-Step(0, con(i).H - 1), &H99FFFFFF

    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    End If
    ReDim lst(1 To 1) As String
    Split con(i).Text, "~", lst()
    con(i).N5 = UBound(lst)
    For j = 1 To con(i).N4
        s$ = Space$(con(i).N3)
        If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
            Mid$(s$, 1, con(i).N3) = lst((con(i).N1 - 1) * con(i).N4 + j)
        End If
        If j <> con(i).N2 Then
            Color con(i).FC
        Else
            Line (con(i).X + 1, con(i).Y + con(i).FontH + (j - 1) * con(i).FontH)-Step(con(i).W - 2, con(i).FontH), con(i).FC, BF
            Color con(i).BC
        End If
        _Font con(i).FHdl
        _PrintString (con(i).X + 4, con(i).Y + con(i).FontH + (j - 1) * con(i).FontH), s$
    Next
End Sub

Sub drwLbl (i As Long)
    If con(i).Hide Then Exit Sub
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
    _Font con(i).FHdl
    Color con(i).FC, con(i).BC
    'mBox "36 or so", Str$((con(i).H - con(i).FontH) / 2)
    _PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y + (con(i).H - con(i).FontH) / 2), con(i).Text
End Sub

Sub drwPic (i As Long, active As Long)
    If con(i).Hide Then Exit Sub
    Dim sd&
    sd& = _Dest
    _Dest con(i).N1
    _PrintMode _KeepBackground
    Line (0, 0)-Step(con(i).W - 1, 20), &HFF008800, BF ' pic title
    Color &HFFCCCCCC
    _PrintString ((con(i).W - 8 * Len(con(i).Text)) / 2, 3), con(i).Text

    If active Then Line (0,0)-Step(con(i).W-1, con(i).H-1), white, B Else _
    Line (0,0)-step(con(i).W-1, con(i).H-1), Black, B
    _Dest 0
    _PutImage (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).N1, 0
    _Dest sd&
End Sub

' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long, shift As Long) ' for all text boxes
    If ky = 19200 Then 'left arrow
        If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
    ElseIf ky = 19712 Then ' right arrow
        If con(i).N1 < con(i).N3 Then con(i).N1 = con(i).N1 + 1: drwTB i, -1
    ElseIf ky = 18176 Then 'home
        con(i).N1 = 1: drwTB i, -1
    ElseIf ky = 20224 Then ' end
        If Len(con(i).Text) + 1 <= con(i).N3 Then
            con(i).N1 = Len(con(i).Text) + 1
        Else
            con(i).N1 = con(i).N3 ' maxCursor right
        End If
        drwTB i, -1
    ElseIf ky >= 32 And ky <= 128 Then
        If Len(con(i).Text) < con(i).N3 Then
            con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Chr$(ky) + Mid$(con(i).Text, con(i).N1)
            If con(i).N1 < con(i).N3 Then con(i).N1 = con(i).N1 + 1
        Else
            Mid$(con(i).Text, con(i).N1, 1) = Chr$(ky) ' just replace char with ky
            If con(i).N1 < con(i).N3 Then con(i).N1 = con(i).N1 + 1
        End If
        drwTB i, -1
    ElseIf ky = 8 Then 'backspace
        If shift Then
            con(i).Text = "": con(i).N1 = 1: drwTB i, -1
        Else
            If con(i).N1 > 1 Then
                con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 2) + Mid$(con(i).Text, con(i).N1)
                con(i).N1 = con(i).N1 - 1: drwTB i, -1
            End If
        End If
    ElseIf ky = 21248 Then 'delete  shit is super delete
        If shift Then
            con(i).Text = "": con(i).N1 = 1: drwTB i, -1
        Else
            con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Mid$(con(i).Text, con(i).N1 + 1): drwTB i, -1
        End If
    End If
End Sub

' this is standard for all List Boxes
Sub LstKeyEvent (i As Long, ky As Long) ' for all text boxes
    If ky = 18432 Then 'up arrow
        If con(i).N2 > 1 Then
            con(i).N2 = con(i).N2 - 1: drwLst i, -1
        Else
            If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwLst i, -1
        End If
    ElseIf ky = 20480 Then ' down arrow
        If con(i).N2 < con(i).N4 And (con(i).N1 - 1) * con(i).N4 + con(i).N2 < con(i).N5 Then
            con(i).N2 = con(i).N2 + 1: drwLst i, -1
        Else
            If con(i).N2 = con(i).N4 Then ' can we start another page
                If con(i).N1 < con(i).N5 / con(i).N4 Then
                    con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwLst i, -1
                End If
            End If
        End If
    ElseIf ky = 18176 Then 'home
        con(i).N1 = 1: con(i).N2 = 1: drwLst i, -1
    ElseIf ky = 20224 Then ' end
        If con(i).N5 Mod con(i).N4 = 0 Then
            con(i).N1 = Int(con(i).N5 / con(i).N4)
            con(i).N2 = con(i).N4
        Else
            con(i).N1 = Int(con(i).N5 / con(i).N4) + 1
            con(i).N2 = con(i).N5 Mod con(i).N4
        End If
        drwLst i, -1
    ElseIf ky = 18688 Then 'pgUp
        If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwLst i, -1
    ElseIf ky = 20736 Then 'pgDn
        If con(i).N1 * con(i).N4 < con(i).N5 Then
            con(i).N1 = con(i).N1 + 1
            If con(i).N1 > Int(con(i).N5 / con(i).N4) Then ' > last whole page check high bar
                If con(i).N2 > con(i).N5 Mod con(i).N4 Then con(i).N2 = con(i).N5 Mod con(i).N4
            End If
            drwLst i, -1
        End If
    End If
End Sub

' This is used and available for maniupating strings to arrays ie change delimiters to commas
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub

' Available if need to create a string from an array
Function Join$ (arr() As String, delimiter$) ' modified to avoid blank lines
    Dim i As Long, b$
    For i = LBound(arr) To UBound(arr)
        If arr(i) <> "" Then
            If b$ = "" Then b$ = arr(i) Else b$ = b$ + delimiter$ + arr(i)
        End If
    Next
    Join$ = b$
End Function

Function LeftOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then LeftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1) Else LeftOf$ = source$
End Function

' update these 2 in case of$ is not found! 2021-02-13
Function RightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then RightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$)) Else RightOf$ = ""
End Function

Function TS$ (n As Long)
    TS$ = _Trim$(Str$(n))
End Function

Sub Remove (item$, a$())
    Dim As Long i, c, lba
    lba = LBound(a$)
    Dim t$(lba To UBound(a$))
    c = lba - 1
    For i = lba To UBound(a$)
        If a$(i) <> "" And a$(i) <> item$ Then c = c + 1: t$(c) = a$(i)
    Next
    ReDim a$(lba To c)
    For i = lba To c
        a$(i) = t$(i)
    Next
End Sub

Sub drawGridRect (x, y, w, h, xstep, ystep) ' top left x, y, x side, y side, number of x, nmber of y
    Dim i
    For i = 0 To w Step xstep
        Line (x + i, y + 0)-(x + i, y + y + h)
    Next
    For i = 0 To h Step ystep
        Line (x + 0, y + i)-(x + w, y + i)
    Next
End Sub

Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
    If xr = 0 Or yr = 0 Then Exit Sub
    Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
    Dim x As Long, y As Long
    w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
    Line (CX - xr, CY)-(CX + xr, CY), C, BF
    Do While y < yr
        y = y + 1
        x = Sqr((h2w2 - y * y * w2) \ h2)
        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
    Loop
End Sub

Sub fcirc (x As Long, y As Long, R As Long, C As _Unsigned Long) 'vince version  fill circle x, y, radius, color
    Dim x0 As Long, y0 As Long, e As Long
    x0 = R: y0 = 0: e = 0
    Do While y0 < x0
        If e <= 0 Then
            y0 = y0 + 1
            Line (x - x0, y + y0)-(x + x0, y + y0), C, BF
            Line (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        Else
            Line (x - y0, y - x0)-(x + y0, y - x0), C, BF
            Line (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1: e = e - 2 * x0
        End If
    Loop
    Line (x - R, y)-(x + R, y), C, BF
End Sub

Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest ' so important
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

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

'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

' 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 Long) ' boxWidthin default 8x16 chars!!!
    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, 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

' for saving and restoring screen settins

Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
    ' Thanks SNcNeill ! for a cross platform method to get file and directory lists
    'put this block in main code section of your program close to top
    '' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
    '    FUNCTION load_dir& (s AS STRING)
    '    FUNCTION has_next_entry& ()
    '    SUB close_dir ()
    '    SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
    'END DECLARE

    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
    Dim nam$
    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory + Chr$(0)) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If (flags And IS_DIR) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        'close_dir 'move to after end if  might correct the multi calls problem
    Else
    End If
    close_dir 'this  might correct the multi calls problem

    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub

Sub GetListStrings (dirOut$, fileOut$)
    ReDim Folders$(1 To 1), Files$(1 To 1) ' setup to call GetLists
    If curPath$ = "" Then curPath$ = _CWD$
    GetLists curPath$, Folders$(), Files$()
    dirOut$ = Join$(Folders$(), "~")
    fileOut$ = Join$(Files$(), "~")
End Sub

That's complete 1000+ lines GUI and maybe even more elegant screen?

I've updated the zip above to match code that drew screen shot in Reply #86.

[Kernelpanic]

The buttons are now elegant too. 

But the red bar above . . . the color ruins the overall impression.

PS:
I rode my bike 30 km in Berlin today. With that I have earned me a good bottle of wine. Off to Lidl or Rewe! 

[bplus]

The buttons are now elegant too. 

But the red bar above . . . the color ruins the overall impression.

That's my title bar from Windows, matches my Toolbar and my preference colors/themes.

What color do you run?

[Kernelpanic]

The buttons are now elegant too. 

But the red bar above . . . the color ruins the overall impression.

That's my title bar from Windows, matches my Toolbar and my preference colors/themes.

What color do you run?

Ah, the title bar. . . that's how it is for me today.

I only know that from before. 

[bplus]

Before the destruction of my good computer by Windows, I was not having fun with GUI when trying to build a Controls Editor.

First of all, using a form with our default .txt file Editor was not working. I think QB64 has to chdir and change back to current dir to update it's files part of internal code. Changes to txt file weren't working when trying to read the file after we exit the txt Editor even with some delay to allow for file writing and closing for the txt Editor.

So! I started a GUI app to do that, get all the control properties and add it to the list of controls from a file and Preview the layout and move and resize the controls, as I had done earlier in this thread with a much smaller set of Control Properties. Quit a job! And I got tired of it when trying to get the Control Height and Control Font Height (You don'r want a Font Height bigger than a Control and with TB fixes I didnt want a Font Height > Control Height - 8 for cursor and nice spacing of letters inside the control and with a List Box you need to fit several lines at Font Height into the Control Height.) and Load the font from a font file to get a Font Handle to call and handle file/font loading errors just so I could use more than one font in an app. It just got crazy complicated and boring!

So! If I ever get back to this project, I will do one set of Font loading handles at the start with the WindowOpen sub like before, one Font file with all the sizes loaded at once! Very Simple! just like 3 digits for a color spec. What I really want from GUI font is different sized letters and digits and I don't really care what kind of fancy curlie cues the letters might have or not have. Just one nice font, readable, sizable and neat will satisfy my font wishes for a very Simple GUI.

BTW I did get the TB problems all worked out AND I could load Text Boxes with text way longer than the width or the Text Box control. Too bad! all that work is lost with the good computer but I remember what it took to get the thing working. In a nut shell you treat the text length by dividing it into sections like a Lst Box with pages, you locate a letter the same way as you locate a line in a List Box.

[Kernelpanic]

It's a shame because the design looks good. The work wasn't in vain, especially with such tasks you learn something new.

It's always better to realize that things can't go on like this at the moment than to get stuck into something. Even big companies have to recognize that: Apple and its Rhapsody

You are in noble society! 

[bplus]

Finally an Update worth the wait I hope. Text Boxes completely reworked and can do text of any length!
Also new: a choice of using default colors (just enter 0, 0 for BOTH FC and BC in NewControl call) or enter a 3 digit number from 0 to 999 for C3 conversion to RBG32 number, a choice of 1000 colors. Now you enter the font you want to use in the OpenWindow call right after including the vs GUI.BI file eg,

Code: (Select All)

'   Set Globals from BI
Xmax = 1280: Ymax = 700: GuiTitle$ = "GUI Makeover #2 Get Filename" ' <<<<<  Window size shared throughout program
OpenWindow Xmax, Ymax, GuiTitle$, "Arial.ttf" ' need to do this before drawing anything from NewControls

Here is the new GUI Controls Editor that use to be called the Forms Designer:
   

Here is a makeover of Kens Arillery b+ mod, my new screen only has a height of 700 so things had to be moved and resized for bigger Fonts. Good thing I have my new Controls editor!
   

Here is the 3 Digit Color picker with 3 different fonts, default controls colors and bigger buttons:
   

Oh and here is the 2nd Makeover of Get Filename, the only place I didn't use default colors were for Current Folder and for Pathed File Selected (used Green for those labels):
   
It's running the 3 Digit Color picker. exe file in a Shell.

So here is the zip with 3 fonts I played with, vs GUI .BI and .BM, 3 Makeover GUI's the main Controls Editor and vs GUI manual/log.
(vs short for Very Simple and it still is.)

PS that file listing in the last screen shot is the zip file's contents without the .exe's.