07-27-2022, 02:42 PM (This post was last modified: 08-05-2022, 01:26 AM by bplus.)
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.
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:
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!
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. Your mountains are different too which is neat. I didn't win at the first game but I shall overcome! LOL
07-27-2022, 04:04 PM (This post was last modified: 07-27-2022, 04:22 PM by bplus.)
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...)
07-27-2022, 08:08 PM (This post was last modified: 07-27-2022, 08:27 PM by bplus.)
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.
07-27-2022, 08:26 PM (This post was last modified: 07-27-2022, 08:29 PM by bplus.)
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.
07-27-2022, 08:49 PM (This post was last modified: 07-27-2022, 08:51 PM by bplus.)
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.
07-29-2022, 02:37 AM (This post was last modified: 07-29-2022, 02:47 AM by bplus.)
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!
'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
'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.
08-02-2022, 11:51 PM (This post was last modified: 08-03-2022, 12:15 AM by bplus.)
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).
Your mountains are different too which is neat. I didn't win at the first game but I shall overcome! LOL
