Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
vs GUI Updates - the latest from b+
#1
I have made a number of refinements to vs GUI, reviewed in the docs file. About the only app not changed was the TTT with AI Game but included in zip, so the first vs GUI Thread may be abandoned and this one can replace it.

Here is the contents of the zip containing all updated apps:
   

First 5 files are 3 ttf Font Files I've tested code with, b+ Very Simple GUI.txt file or docs file that Introduces the vs GUI library and Controls System with Change plus Log of development, and direntry.h file that allows cross platform file and folders listings access.

Then 6 bas source files for apps:
#1 GUI Controls Editor.bas - helps get the Controls setup for a vs GUI app. Along with editing the Properties you can test the layout.

#5 GUI Practice Load.bas - is a file to practice with the Controls Editor.

#2 GUI Makeover Get Filename #4 is a handy file for Running, Killing, or Clipboard listing fully pathed Filenames.

#3 GUI makeover 3 Digit Color Color Picker.bas - is 3 digit system used to name colors for controls, the 3 digits are converted to RGB, making it simple to say and transfer color values. 1000 different shades can be designated with 3 digits.

#4 GUI TTT with AI.bas is just the unbeatable Tic Tac Toe game using GUI. You can compare to Fellippe's Inform version.

#6 Makeover #2 Kens Artillary B+ mod.bas is improved not only with larger text in GUI but also I got the AI working again and the computer will be a much tougher opponent!

Finally the last 2 files are the vs GUI.BI and .BM library code.


Attached Files
.zip   vs GUI 2022-07-27 Update.zip (Size: 802.12 KB / Downloads: 97)
b = b + ...
Reply
#2
Lets take a look at the Controls Editor with a few snapshots loading the Practice file and Editing it.

Main Window of the Controls Editor (made with vs GUI)
   

Now click top Left Button to load the Controls from the GUI Practice Load.bas file, you will see this very like the GUI Get Filename app.
     

With the Practice file highlighted I click the OK that File! button (bottom left) and I will return to main screen with the controls loaded from that file.
   

OK so lets check the Layout of the Controls (they are all just boxes that look better laid out spaced evenly on a grid)
   

Grab (mouse down and drag) the top, left corner to move them, Grab the bottom right corner to resize them:
   
b = b + ...
Reply
#3
OK now to return to Main Screen, click the small < in the top left corner and we have the new X, Y, W, H values loaded into the controls. BTW you are looking at the code lines that add controls to the GUI app done through the NewControls() Function call.

Lets add a new label that will be a picture image on the left side:
   

Check the Layout
   

Hmm... fix the spacing, go back to main window and File it! Then we will exit the Controls Editor, Run the Practice file in QB64 IDE and see how it looks, oh I should get a long narrow image!
b = b + ...
Reply
#4
LOL B+! Awesome rendition of the Artillery game! Yours is a little harder than mine because your grass doesn't make the holes like mine does. But your mountain does and your cannons. Smile Your mountains are different too which is neat. I didn't win at the first game but I shall overcome! LOL
Reply
#5
Smile Ken thanks so much!

OK I decided to add an Image label, the filename is img.jpeg a little fatter than I had in mind but what a picture!

Here is the Practice File again, Main screen adding the big image on the left side after moving the others right to make room.
   

And the new layout:
   

Now back to main screen to File the edited controls back into the GUI Practice Load.bas file (spelled badly).
Then I load the GUI Practice Load.bas file into IDE and Run it to get this (no code for any of controls but...)
   
b = b + ...
Reply
#6
If you want to start a GUI app from the Controls Editor, it will set you up with starting Template.

Here is an example of what it wrote for me for a 1 Label App start. I have inserted  <<< comments in places in a couple of areas:
Code: (Select All)
'$include:'vs GUI.BI'
'   Set Globals from BI              your Title here VVV
Xmax = 1280: Ymax = 720: GuiTitle$ = "GUI One Label"

' >>> FontFile$ = "arial.ttf" ... a .ttf Font File is needed as 4th parameter on next line
OpenWindow Xmax, Ymax, GuiTitle$, FontFile$ ' <<< inserted last parameter need to do this before drawing anything from NewControls

' >>> Next line is needed only if you want to edit controls in the Controls Editor
' GUI Controls
'                     Dim and set Globals for GUI app
Dim Shared As Long lblScreen
lblScreen = NewControl(4, 10, 10, 1200, 30, 30, 50, 669, "Testing the save of one label to start a GUI bas application")
' End GUI Controls
' >>> Above line is needed if you want to edit your controls in the Controls Editor

MainRouter ' after all controls setup

Sub BtnClickEvent (i As Long)
    Select Case i
    End Select
End Sub

Sub LstSelectEvent (control As Long)
    Select Case control
    End Select
End Sub

Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)
    Select Case i
    End Select
End Sub

Sub PicFrameUpdate (i As Long)
    Select Case i
    End Select
End Sub

'$include:'vs GUI.BM'
 
Once the font file is added/fixed in the Open Window line the IDE can run the code to give you a look on the screen size you want.
b = b + ...
Reply
#7
Here is the GUI Tabulator Interface for Plotting F(x) Project Folder. It needs it's own Folder because the Tabulator reads and writes a couple of files. It needs to be compiled before using the GUI Interface.

Sample plot of (5x-10)(x+3) = 5*X^2 + 5*X -30 roots (y = 0 when x =) 2, -3
   

Again the zip folder should have everything you need for it to work but you must compile the tabulator.

There was some error involving upper case that I fixed along with the GUI app with bigger fonts. I'm sure that's not the end of errors. Wink


Attached Files
.zip   GUI Interface with Tabulator For Plotting.zip (Size: 562.96 KB / Downloads: 69)
b = b + ...
Reply
#8
Here is an early or late Christmas present, a GUI Memory Game. It has a Christmas theme because I already had 9 images from my Christmas themed Sudoku Game. You can use any 17 images that are around 200 x 200 +- 100 or so, just have them pretty close to square so no distortion from stretch and shrink. Mark the image files d1.png to d17.png and you wont have to change a drop of code!

Here is a game in progress:
   

And here is the zip Folder, should have everything you need to run the code from IDE from it's separate folder.


Attached Files
.zip   GUI Memory Game.zip (Size: 828.09 KB / Downloads: 68)
b = b + ...
Reply
#9
OK I made a wrong turn when mouse over was all that was needed to change the Active Control. Nope you have to left or right click the control to make it active. 

I also started printing out the List Box like I did with Text Box so that all the letters will align and wont be thrown off by more or less spaces.

Here is GUI Adding Machine. With the redeveloped BM still embedded in file, the vs GUI.BI, direntry.h file and arial.ttf you can get from 1st Post if you don't have it already.

Code: (Select All)
'$include:'vs GUI.BI'
Option _Explicit
'   Set Globals from BI
Xmax = 920: Ymax = 700: GuiTitle$ = "GUI Adding Machine"
OpenWindow Xmax, Ymax, GuiTitle$, "arial.ttf" ' need to do this before drawing anything from NewControls
Randomize Timer
Dim Shared As Long Btn(1 To 20), tbN, tbT, LB ' our 15 buttons now!
Dim Shared As _Integer64 Num, Total
Dim Shared B$, Tape$
init
MainRouter ' just wait for player to fire

Sub BtnClickEvent (i As Long)
    Dim s$
    _Delay .2 ' because the delay isn't done until after this is processed! need to fix that in MainRouter
    '7890C
    '456o<
    '123+-
    'Key#   12345678       9 00      10 <-      12345
    'bt$ = "7890C456" + Chr$(148) + Chr$(27) + "123+-"
    Select Case i
        Case 1, 2, 3, 4, 6, 7, 8, 11, 12, 13 ' 7890 567 123
            B$ = B$ + con(i).Text: Num = Val(B$): con(tbN).Text = Dot2_17$(Num): drwTB tbN, 0
        Case 5 ' C
            B$ = "": Num = 0: con(tbN).Text = Dot2_17$(Num): drwTB tbN, 0
            Total = 0: con(tbT).Text = Dot2_17$(Total): drwTB tbT, 0
            Tape$ = Tape$ + "~" + " "
            GoSub updateLB
        Case 9 ' chr$(148) for 00
            B$ = B$ + "00": Num = Val(B$): con(tbN).Text = Dot2_17$(Num): drwTB tbN, 0
        Case 10 ' backspace <-
            If Len(B$) Then
                B$ = Left$(B$, Len(B$) - 1): Num = Val(B$): con(tbN).Text = Dot2_17$(Num)
                drwTB tbN, 0
            End If
        Case 14 ' +
            If B$ <> "" Then Num = Val(B$) ' Else Num = num
            Total = Total + Num
            con(tbT).Text = Dot2_17$(Total): drwTB tbT, 0
            B$ = "" ' my calc does not change the screen
            Tape$ = Tape$ + "~" + "+ " + Dot2_17$(Num)
            GoSub updateLB
        Case 15 ' -
            If B$ <> "" Then Num = Val(B$) ' Else Num = num
            Total = Total - Num
            con(tbT).Text = Dot2_17$(Total): drwTB tbT, 0
            B$ = "" ' my calc does not change the screen
            Tape$ = Tape$ + "~" + "- " + Dot2_17$(Num)
            GoSub updateLB
    End Select
    Exit Sub
    updateLB:
    Tape$ = Tape$ + "~" + "T " + Dot2_17$(Total)
    con(LB).Text = Tape$ ' sets the delimited string into lst's text for splitting
    drwLst LB, 0 ' this updates list box with new line(s) splitting out the tape$
    LstKeyEvent LB, 20224 '  this moves highlite to end and of the tape$
    Return
End Sub

Sub LstSelectEvent (control As Long)
    Select Case control
    End Select
End Sub

Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)
    Select Case i
    End Select
End Sub

Sub PicFrameUpdate (i As Long)
    Select Case i
    End Select
End Sub

' For Adding Machine
Sub init
    Dim bt$
    Dim As Long x, y, i
    '7890C
    '456o<
    '123+-
    'Key#  12345678       9 00      10 <-      12345
    bt$ = "7890C456" + Chr$(148) + Chr$(27) + "123+-"
    i = 1
    For y = 0 To 2
        For x = 0 To 4
            Btn(i) = NewControl(1, x * 120 + 20, y * 120 + 220, 100, 100, 64, 99, 33, Mid$(bt$, i, 1))
            i = i + 1
        Next
    Next
    tbN = NewControl(2, 20, 20, 580, 80, 54, 0, 666, "")
    tbT = NewControl(2, 20, 110, 580, 80, 54, 0, 666, Dot2_17$(0))
    LB = NewControl(3, 620, 20, 280, 660, 20, 0, 888, "")
    Tape$ = "T " + Dot2_17$(0)
    con(LB).Text = Tape$
    drwLst LB, 0
End Sub

' this formats a _integer64 type number into a right aligned 17 places and places dot 2 places in
' so fits up to 9,999,999,999.99 dollars or some other unit
Function Dot2_17$ (cents As _Integer64) ' modified for right aligned in 14 spaces
    Dim s$, rtn$, sign$
    s$ = _Trim$(Str$(cents)) ' TS$ is for long
    If Left$(s$, 1) = "-" Then sign$ = "-": s$ = Mid$(s$, 2) Else sign$ = ""
    If Len(s$) = 1 Then
        s$ = sign$ + "0.0" + s$
    ElseIf Len(s$) = 2 Then
        s$ = sign$ + "0." + s$
    Else
        s$ = sign$ + Mid$(s$, 1, Len(s$) - 2) + "." + Mid$(s$, Len(s$) - 1)
    End If
    rtn$ = Space$(17)
    s$ = _Trim$(s$)
    Mid$(rtn$, 17 - Len(s$)) = s$
    Dot2_17$ = rtn$
End Function

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

'=============================================================================================
' GUI.BM 2022-07-20 add Function LstHighliteItem$
' Change MainRouter clicking outside a control was changing the active control, no more!
' If Mouse Over a Control, that controls becomes active, don't try and Tab off a control that a
' mouse is over, mouse wins!
' 2022-07-25
' Do display after all drwX's
' Font Heights for Text Boxes, Btns, Pic Box (but that is stupid no room for pic) now only have to
' be 2 pixels less than Control Height.
' Removed N6, Text2, Fhdl, FontFile, ImgFile from the Control Type for vs GUI.
' Aha! to do an image file instead of Text use ">Filename.ext" for the text.
' 2022-07-26
' Another fix in MainRouter, Exit For when found the control mouse is inside. Needed this when a
' Click switched screens and threw errors because it was a whole different set of controls!

' GUI.BM 2022-07-28 More updates
' 1. Wrong turn was made activating controls with just MouseOver, wait for click into the control.
'    Then use the clear button immediately because Main Router shoots all over updating controls.
' 2. Clear MouseButton as soon as we know it was released by user, use OldMoses method
'    didn't work back to _delay 2 but immediately after click is detected.
' 3. I want aligned columns of text in list box, this means to print text like I do in Text Box.
' 4. Coming soon Speaking of Aligning, I want Labels aligned, N1 is for images, so N2 is next up.
'    N1 for image handles, N2 Alinment = 0 for centered, = 1 Left Aligned, = 2 Right Aligned
' Reworking vs GUI.BM from new GUI Adding Machine app, then check it out with all the others.

Function LstHighliteItem$ (controlI As Long) ' 2022-07-20 adding this to BM
    ReDim lst(1 To 1) As String 'need to find highlighted item
    Split con(controlI).Text, "~", lst()
    LstHighliteItem$ = lst((con(controlI).N1 - 1) * con(controlI).N4 + con(controlI).N2)
End Function

Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long,_
FontH As Long, FC As Long, BC As Long, s$) ' dims are pixels
    Dim As Long a
    NControls = NControls + 1
    ReDim _Preserve con(0 To NControls) As Control
    con(NControls).ConType = ConType
    con(NControls).X = X
    con(NControls).Y = Y
    con(NControls).W = W
    con(NControls).H = H
    con(NControls).Text = s$
    ActiveControl = 1
    If NControls = 1 Then a = 1 Else a = 0
    Select Case ConType
        Case 1
            con(NControls).N1 = 0
            If Left$(s$, 1) = "<" Then
                If _FileExists(Mid$(s$, 2)) Then con(NControls).N1 = _LoadImage(Mid$(s$, 2))
            End If
            If FontH < H - 1 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 2
            If FC = 0 And BC = 0 Then ' use default colors
                con(NControls).FC = C3(800): con(NControls).BC = C3(888)
            Else ' convert to RGB
                con(NControls).FC = C3(FC): con(NControls).BC = C3(BC)
            End If
            drwBtn NControls, a
        Case 2
            If FontH < H - 1 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 2
            If FC = 0 And BC = 0 Then ' use default colors
                con(NControls).FC = C3(778): con(NControls).BC = C3(225)
            Else ' convert to RGB
                con(NControls).FC = C3(FC): con(NControls).BC = C3(BC)
            End If
            con(NControls).N1 = 1 ' page/section
            con(NControls).N2 = 1 ' highlite
            con(NControls).N3 = Int(con(NControls).FontH * .65) ' width of character
            con(NControls).N4 = Int((con(NControls).W - 4) / con(NControls).N3) ' width of section
            con(NControls).N5 = Len(con(NControls).Text) + 1
            drwTB NControls, a
        Case 3
            If FC = 0 And BC = 0 Then ' use default colors
                con(NControls).FC = C3(889): con(NControls).BC = C3(336)
            Else ' convert to RGB
                con(NControls).FC = C3(FC): con(NControls).BC = C3(BC)
            End If
            If 3 * FontH > H Then con(NControls).FontH = Int(H / 3) Else con(NControls).FontH = FontH
            con(NControls).N1 = 1 ' page number
            con(NControls).N2 = 1 ' select highlite bar
            con(NControls).N3 = W / Int(con(NControls).FontH * .65)
            con(NControls).N4 = Int((H - 2 * con(NControls).FontH) / con(NControls).FontH)
            '                page height 2 empty lines for home, end, page up, page down clicking
            ' n5 changes according to lines delimiters in text
            drwLst NControls, a
        Case 4
            con(NControls).N1 = 0
            If Left$(s$, 1) = "<" Then
                If _FileExists(Mid$(s$, 2)) Then con(NControls).N1 = _LoadImage(Mid$(s$, 2))
            End If
            If FontH <= H Then con(NControls).FontH = FontH Else con(NControls).FontH = H
            If FC = 0 And BC = 0 Then ' use default colors
                con(NControls).FC = C3(889): con(NControls).BC = screenBC
            Else ' convert to RGB
                con(NControls).FC = C3(FC): con(NControls).BC = C3(BC)
            End If
            drwLbl NControls
        Case 5
            If FontH < H - 1 Then con(NControls).FontH = FontH Else con(NControls).FontH = H - 2
            If s$ <> "" Then ' label color is
                If FC = 0 And BC = 0 Then ' use default colors
                    con(NControls).FC = C3(590): con(NControls).BC = C3(40)
                Else ' convert to RGB
                    con(NControls).FC = C3(FC): con(NControls).BC = C3(BC)
                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

Sub MainRouter
    Dim As Long kh, mx, my, mb1, mb2, i, shift, temp
    Do
        ' mouse clicks and tabs will decide the active control
        While _MouseInput ' scroll lst if active while polling mouse
            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)
        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 ' we are  inside a control
                    ' do we have a mouse click inside a control?
                    If mb1 Then ' click, find which type control we are in and exit for
                        _Delay .2
                        If i <> ActiveControl And con(i).ConType <> 4 Then ' active control is changed
                            activateControl ActiveControl, 0
                            ActiveControl = i
                            activateControl ActiveControl, -1
                        End If
                        If con(i).ConType = 1 Then
                            BtnClickEvent i
                        ElseIf con(i).ConType = 2 Then ' move cursor to click point
                            If mx > con(i).X + 4 And mx < con(i).X + con(i).W Then
                                If my >= con(i).Y And my <= con(i).Y + con(i).H Then
                                    con(i).N2 = Int((mx - (con(i).X + 4)) / con(i).N3) + 1
                                    If (con(i).N1 - 1) * con(i).N4 + con(i).N2 > con(i).N5 Then
                                        If con(i).N5 Mod con(i).N4 = 0 Then
                                            'last page exactly at end of it
                                            con(i).N1 = Int(con(i).N5 / con(i).N4)
                                            con(i).N2 = con(i).N4
                                        Else
                                            ' last page with only some lines
                                            con(i).N1 = Int(con(i).N5 / con(i).N4) + 1
                                            con(i).N2 = con(i).N5 Mod con(i).N4
                                        End If
                                    End If
                                    drwTB i, -1
                                End If
                            End If
                        ElseIf con(i).ConType = 3 Then
                            If my >= con(i).Y And my <= con(i).Y + con(i).FontH Then ' top empty
                                If mx < con(i).X + .5 * con(i).W Then 'home else pgUp
                                    LstKeyEvent i, 18176 ' home
                                ElseIf mx > con(i).X + .5 * con(i).W Then
                                    LstKeyEvent i, 18688 ' pgup
                                End If
                            ElseIf my >= con(i).Y + con(i).H - con(i).FontH Then
                                If my <= con(i).Y + con(i).H Then
                                    If mx < con(i).X + .5 * con(i).W Then 'end else pgDn
                                        LstKeyEvent i, 20224 ' end
                                    ElseIf mx > con(i).X + .5 * con(i).W Then
                                        LstKeyEvent i, 20736 ' pgdn
                                    End If
                                End If
                            ElseIf my >= con(i).Y + con(i).FontH Then
                                If my < con(i).Y + con(i).H - con(i).FontH Then
                                    temp = Int((my - con(i).Y - con(i).FontH) / con(i).FontH)
                                    con(i).N2 = temp + 1
                                    If (con(i).N1 - 1) * con(i).N4 + con(i).N2 > con(i).N5 Then
                                        LstKeyEvent i, 20224 ' end
                                    End If
                                    drwLst i, -1
                                End If
                            End If
                        ElseIf con(i).ConType = 5 Then
                            PicClickEvent i, mx - con(i).X, my - con(i).Y 'picture box click event
                        End If ' what kind of control
                    End If ' left click a control check

                    If mb2 Then ' check right clicking to select
                        _Delay .2
                        If i <> ActiveControl And con(i).ConType <> 4 Then ' active control is changed
                            activateControl ActiveControl, 0
                            ActiveControl = i
                            activateControl ActiveControl, -1
                        End If
                        If con(i).ConType = 3 Then ' only selecting in lst box
                            LstSelectEvent i ' check event called for 5
                        End If ' control type 3
                    End If ' mb2
                    Exit For ' should only be inside one control
                End If ' y is inside control
            End If 'x inside control
        Next

        kh = _KeyHit ' now for key presses
        shift = _KeyDown(100304) Or _KeyDown(100303)
        If kh = 9 Then 'tab
            If shift Then shiftActiveControl -1 Else shiftActiveControl 1
        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
            LstSelectEvent ActiveControl
            shiftActiveControl 1
        End If
        If con(ActiveControl).ConType = 2 Then
            TBKeyEvent ActiveControl, kh, shift ' this handles keypress in active textbox
        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
        Next
        _Display
        _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$, fontFile$)
    Screen _NewImage(WinWidth, WinHeight, 32)
    _ScreenMove 80, 0
    _PrintMode _KeepBackground
    _Title title$
    curPath$ = _CWD$ ' might need this for file stuff
    Color White, screenBC
    Cls
    Dim As Long j
    For j = 6 To 128
        fontHandle&(j) = _LoadFont(fontFile$, j)
        If fontHandle&(j) <= 0 Then
            Cls
            Print "Font did not load (OpenWindow sub) at height" + Str$(j) + ", goodbye!"
            Sleep: End
        End If
    Next
End Sub

Sub drwBtn (i As Long, active As Long) ' gray back, black text
    Dim As Long tempX, tempY
    If con(i).N1 > -2 Then ' no image
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
        _Font fontHandle&(con(i).FontH)
        tempX = con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2
        tempY = con(i).Y + (con(i).H - con(i).FontH) / 2
        If con(i).FontH >= 20 Then
            Color Black
            _PrintString (tempX - 1, tempY - 1), con(i).Text
        End If
        Color con(i).FC
        _PrintString (tempX, tempY), con(i).Text
    Else
        _PutImage (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).N1, 0
    End If
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, 0), White
        Line (con(i).X, con(i).Y)-Step(0, con(i).H), White
        Line (con(i).X + con(i).W, con(i).Y)-Step(0, con(i).H), Black
        Line (con(i).X, con(i).Y + con(i).H)-Step(con(i).W, 0), Black
    End If
    _Display
End Sub

Sub drwTB (i As Long, active As Long) ' blue back, white text
    ' just like LstBox
    ' N1 = section / page number we are on
    ' N2 = current location of the highlight bar on the page 1 to page/section width
    ' N3 = char width allowed for char fontH * .65
    ' N4 = page height or section width
    ' N5 = len(text) + 1 upperbound of letters

    Dim As Long j, xoff, tempX
    Dim t$
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, 0), Black
        Line (con(i).X, con(i).Y)-Step(0, con(i).H), Black
        Line (con(i).X + con(i).W, con(i).Y)-Step(0, con(i).H), White
        Line (con(i).X, con(i).Y + con(i).H)-Step(con(i).W, 0), White
    End If
    con(i).N5 = Len(con(i).Text) + 1 ' allow for 1 more char insertion or insertion on end
    _Font fontHandle&(con(i).FontH)
    For j = 1 To con(i).N4
        If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
            t$ = Mid$(con(i).Text, (con(i).N1 - 1) * con(i).N4 + j, 1)
            xoff = (con(i).N3 - _PrintWidth(t$)) / 2
            tempX = con(i).X + 4 + (j - 1) * con(i).N3
            If j <> con(i).N2 Or active = 0 Then
                Color con(i).FC
            Else ' cursor
                Line (tempX + 1, con(i).Y)-Step(con(i).N3, con(i).H - 2), con(i).FC, BF
                Color con(i).BC
            End If
            _PrintString (tempX + xoff, con(i).Y + (con(i).H - con(i).FontH) / 2), t$
        End If
    Next
    _Display
End Sub

Sub drwLst (i As Long, active As Long)
    ' 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 As Long j, k, listPos, tempY, charW, xo
    Dim char$
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, 0), Black
        Line (con(i).X, con(i).Y)-Step(0, con(i).H), Black
        Line (con(i).X + con(i).W, con(i).Y)-Step(0, con(i).H), White
        Line (con(i).X, con(i).Y + con(i).H)-Step(con(i).W, 0), White
    End If
    ReDim lst(1 To 1) As String
    Split con(i).Text, "~", lst()
    con(i).N5 = UBound(lst)
    _Font fontHandle&(con(i).FontH)
    charW = .65 * con(i).FontH
    For j = 1 To con(i).N4 ' - 1
        listPos = (con(i).N1 - 1) * con(i).N4 + j
        If listPos <= con(i).N5 Then
            tempY = con(i).Y + con(i).FontH + (j - 1) * con(i).FontH
            If j <> con(i).N2 Then
                Color con(i).FC
            Else
                Line (con(i).X + 1, tempY)-Step(con(i).W - 2, con(i).FontH), con(i).FC, BF
                Color con(i).BC
            End If
            For k = 1 To con(i).N3
                char$ = Mid$(lst(listPos), k, 1)
                xo = .5 * (charW - _PrintWidth(char$))
                _PrintString (con(i).X + 4 + (k - 1) * charW + xo, tempY), char$
            Next
        End If
    Next
    _Display
End Sub

Sub drwLbl (i As Long)
    Dim As Long tempX
    If con(i).N1 > -2 Then ' no image
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).BC, BF
        _Font fontHandle&(con(i).FontH)
        tempX = con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2
        If con(i).FontH >= 20 Then
            Color Black
            _PrintString (tempX + 1, con(i).Y + (con(i).H - con(i).FontH) / 2 + 1), con(i).Text
        End If
        Color con(i).FC
        _PrintString (tempX, con(i).Y + (con(i).H - con(i).FontH) / 2), con(i).Text
    Else
        _PutImage (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).N1, 0
    End If
    _Display
End Sub

Sub drwPic (i As Long, active As Long)
    Dim As Long tempY
    If con(i).Text <> "" Then ' title to display
        Dim sd&
        sd& = _Dest
        _Dest con(i).N1
        Line (0, con(i).H - con(i).FontH - 2)-Step(con(i).W - 1, con(i).FontH + 2), con(i).BC, BF
        _Font fontHandle&(con(i).FontH)
        Color con(i).FC, con(i).BC
        tempY = con(i).H - con(i).FontH - 1
        _PrintString ((con(i).W - _PrintWidth(con(i).Text)) / 2, tempY), con(i).Text
        _Dest 0
        _PutImage (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), con(i).N1, 0
        _Dest sd&
    End If
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), White, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), Black, B
    End If
    _Display
End Sub

' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long, shift As Long) ' for all text boxes
    Dim As Long L
    ' just like LstBox
    ' N1 = section / page number we are on
    ' N2 = current location of the highlight bar on the page 1 to page/section width
    ' N3 = char width allowed for char fontH * .65
    ' N4 = page height or section width
    ' N5 = len(text) + 1 upperbound of letters
    L = (con(i).N1 - 1) * con(i).N4 + con(i).N2 ' help shorten really long lines
    If ky = 19200 Then 'left arrow
        If con(i).N2 > 1 Then
            con(i).N2 = con(i).N2 - 1: drwTB i, -1
        Else
            If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwTB i, -1
        End If
    ElseIf ky = 19712 Then ' right 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: drwTB i, -1
        Else
            If con(i).N2 = con(i).N4 Then ' can we move to another page
                If con(i).N1 < con(i).N5 / con(i).N4 Then
                    con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwTB i, -1
                End If
            End If
        End If
    ElseIf ky = 18176 Then ' home
        con(i).N1 = 1: con(i).N2 = 1: drwTB 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
        drwTB i, -1
    ElseIf ky = 18688 Then ' PgUp
        If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
    ElseIf ky = 20736 Then ' PgDn
        If con(i).N1 < con(i).N5 / con(i).N4 Then
            con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwTB i, -1
        End If
    ElseIf ky >= 32 And ky <= 128 Then ' normal letter or digit or symbol
        con(i).Text = Mid$(con(i).Text, 1, L - 1) + Chr$(ky) + Mid$(con(i).Text, L)
        con(i).N5 = Len(con(i).Text) + 1
        ' now do right arrow code
        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: drwTB i, -1
        Else
            If con(i).N2 = con(i).N4 Then ' can we move to another page
                If con(i).N1 < con(i).N5 / con(i).N4 Then
                    con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwTB i, -1
                End If
            End If
        End If
    ElseIf ky = 8 Then 'backspace
        If shift Then
            con(i).Text = "": con(i).N2 = 1: con(i).N1 = 1: con(i).N5 = 1: drwTB i, -1
        Else
            If con(i).N2 > 1 Then
                con(i).Text = Mid$(con(i).Text, 1, L - 2) + Mid$(con(i).Text, L)
                con(i).N5 = Len(con(i).Text) + 1
                con(i).N2 = con(i).N2 - 1: drwTB i, -1
            ElseIf con(i).N1 <> 1 Then
                con(i).Text = Mid$(con(i).Text, 1, L - 2) + Mid$(con(i).Text, L)
                con(i).N5 = Len(con(i).Text) + 1
                con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwTB i, -1
            End If
        End If
    ElseIf ky = 21248 Then 'delete  shift is super delete
        If shift Then
            con(i).Text = "": con(i).N2 = 1: con(i).N1 = 1: con(i).N5 = 1: drwTB i, -1
        Else
            con(i).Text = Mid$(con(i).Text, 1, L - 1) + Mid$(con(i).Text, L + 1)
            con(i).N5 = Len(con(i).Text) + 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, loadArray() 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(loadArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadArray) Then
            ReDim _Preserve loadArray(LBound(loadArray) To UBound(loadArray) + 1000) As String
        End If
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadArray(LBound(loadArray) 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 If
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 If
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

Function C3~& (i As Long) ' from 0 to 999 3 digit pos integers
    Dim s$
    s$ = Right$("   " + Str$(i), 3)
    C3~& = _RGB32(Val(Mid$(s$, 1, 1)) * 28, Val(Mid$(s$, 2, 1)) * 28, Val(Mid$(s$, 3, 1)) * 28)
End Function

Sub drawGridRect (x, y, w, h, xstep, ystep)
    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
    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
    fg = &HFF000055 '<  change as desired  prompt text color, back color or type in area
    bg = &HFF6080CC '<  change as desired  used fore color in type in area

    '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,
                        d = Mid$(b, j, 1)
                        If d = " " Then ' until find a space
                            t(ti) = Mid$(b, 1, j - 1): b = tail + c 'save the tail
                            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 'is mouse down on title bar to grab and move ?
            If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then
                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 Then
                        If my - graby >= 0 And my - graby <= sh - bxH Then
                            'attempt to speed up with less updates
                            i = (lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2
                            If i ^ .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
                    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, needs to be longer than title$ and prompt$
' 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 As Long bxW, bxH, mb, mx, my, mi, grabx, graby, tlx, tly, lastx, lasty, dist
    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 'is mouse down on title bar for a grab and move?
            If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then
                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 Then
                        If my - graby >= 0 And my - graby <= sh - bxH Then
                            'attempt to speed up with less updates
                            dist = (lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2
                            If dist ^ .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
                    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
                End If
            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 As Long flags, file_size, length
    Dim As Integer DirCount, FileCount
    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)
                    End If
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then
                        ReDim _Preserve FileList(UBound(FileList) + 100)
                    End If
                    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 ' 937  +50 = 987 now 2022-7-26

   

Oh BTW, the o with 2 dots over it prints 2 zeros also notice NO DECIMAL POINT in keys, it is inserted when the number is printed. That is what the o with 3 dots is for, converting pennies to dollars. PS I eliminated 5 Keys from when I started that's why all the space under them.
b = b + ...
Reply
#10
This is an Update to the vs GUI Project for 2022-08-02.

Changes:
Now Mouse has to click into a Control to make it active. This reverses the change I made in last update, just mouse-over was changing the Active Control, BIG MISTAKE!

Now a vertical bar black white and gray to stand out from the FC and BC colors of the Textbox. Now you are less likely to think the letter you type will replace the letter highlighted because they aren't highlighted anymore. The vertical bar makes sense, it's what this forum's editor uses!

Now the letters are printed out equally spaced in List boxes making number aligned columns perfect. We pay for that by needing much wider List boxes.

The Controls Editor has been completely re-laid out using the Controls Editor and the Practice Load file got a copy of the controls used in Controls Editor, kind of neat.

Now you can align labels Left or Right if you don't like default of Centered. 

Oh, there is also a new get_filename.exe a variation of GUI Makeover #5 Get Filename (now with way wider List Boxes!) I am using an Independent Filename retriever to avoid loading my GUI code up with File Dialog controls. Works good, I am using it with Accts Tracker to access several different Account Transaction Journals (4 at moment).  This app still needs more edit controls, meanwhile to fix errors I am using a regular Text Editor. The app recalc's the balances on each transaction recorded when it loads a file. get_filename.exe creates a small file named of all things filename.txt and is stored in same directory as get_filename.exe. It just contains the user chosen pathed filename or nothing if user bugs out of get_filename cancelling the get.

Here is a copy of the zip's contents, the old apps have been rechecked and fixed up with the new BI/BM but most didn't need any code changes. 
   

Up to 10 bas source files:
Adding Machine and Account Tracker are new and the GUI Blank is just a template file to get a GUI started.

BTW I did not include the Interface with the Tabulator but it works much better now that you can Tab or Shift Tab out of a control the mouse is hovering over.
The other GUI project Xmas Memory Game was not effected by the new BI/BM that I can recall nor TTT for that matter.

PS be sure to compile get_filename.bas before trying Account Tracker, that exe has to be in same folder as the GUI Account Tracker to get filenames of accounts journals started (the accounts can be anywhere but might make sense to be in same folder as Account Tracker and get_filename,exe).


Attached Files
.zip   GUI Update 2022-08-02.zip (Size: 828.54 KB / Downloads: 77)
b = b + ...
Reply




Users browsing this thread: 3 Guest(s)