Thanks to all for support and feedback.
For my next installment something practical, a filename selector that allows you to run a file in Shell (DontWait) or Kill it! (Might as well cleanout some old files while I am testing code.) For Kills, I do make you confirm your choice by typing y for yes in an InputBox$ (which added allot of code for a silly y. I tried Fellippe's very simple MessageBox and was getting crazy or no results. I had to make screen pretty wide to fit Pathed Filenames across the breadth of the screen.
So here is code, you need direntry.h in your QB64.exe folder, a copy is provided commented out at the bottom of this code, remove comments and paste in txt file editor and save as direntry.h in QB64.exe folder. Oh I had to change my delimiter for Join$ of arrays because I had files with comma's in the title which the splitter busted up! So now using ~ to delimit strings.
Here is a screenshot of GUI Get Filename running some code with a bug in it ;-))
Linux might not have a problem with this, I used the other slanted slash to Join the path to the filename, see selected file label.
Wait does Linux do Shell?
For my next installment something practical, a filename selector that allows you to run a file in Shell (DontWait) or Kill it! (Might as well cleanout some old files while I am testing code.) For Kills, I do make you confirm your choice by typing y for yes in an InputBox$ (which added allot of code for a silly y. I tried Fellippe's very simple MessageBox and was getting crazy or no results. I had to make screen pretty wide to fit Pathed Filenames across the breadth of the screen.
So here is code, you need direntry.h in your QB64.exe folder, a copy is provided commented out at the bottom of this code, remove comments and paste in txt file editor and save as direntry.h in QB64.exe folder. Oh I had to change my delimiter for Join$ of arrays because I had files with comma's in the title which the splitter busted up! So now using ~ to delimit strings.
Code: (Select All)
Option _Explicit
_Title "Get Filename test GUI-6-16" 'b+ 2022-06-16 test an appl with GUI as of 6-15
' from "GUI - add Misc 2022-06-15"
' 2022-06-14 & 15 add ListBoxes and Labels
' 2022-06-15 & 16, change labels to a control and change Sub NewControl to a Function that returns
' the index number to control variable name. (Take out ID as property in Control Type)
' This should make it easier to modify screens using variable names for your controls.
' change i, active in drwBtn and drwTB
' 2022-06-16 To test something serious I have Get Filename and once gotten you can Run it,
' Kill it or Cancel/Quit. I had to add GetLists which needs Direntry.h in QB64.exe Folder.
' A copy is provided at the end of this code. Dang need new file delimiter, some files have
' comma's in their name! Dang need wider screen!
' GUI Notes:
' Very simple buttons and textboxes for starters"
' Use white border for active control, black for inactive ones.
' Use Tab and Shift+Tab for shifting active control else Mouse Click, to cursor position in TextBox
' or item in list box.
' Main loop will decide active control ID is basically the Index order for controls same as you
' post them with NewControl conType, X, Y, W, H, Text
' btn conType is 1, press enter to cause click event if tab to btn
' Active control moves down to next when clicked or enter press.
' textBox conType = 2
' height needs to be at least 32 pixels high for cursor below letters in box
' N1 is cursor position
' N2 to track toggle for blinking cursor
' Enter keypress on textBox will shift Active conrol down the index by 1
' Hint: When change text, change cursor N1 to len(con(i).text) + 1
' ListBox conType = 3
' for LstBx need to Join$ (Function below) an array into a ~ delimited string for Text in NewControl
' 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 (32 pixels) are left blank at top and bottom for mouse click navigation.
' N5 = Ubound of the list() base 1 ie last item number
' text = a splitable into array so need split N5 is (re)discovered in split when drawn
' Enter Keypress selects the highlited item in List bx and moves active control to next control in ID ie index
' Left click Blank Top Left side > Home
' Left Click Blank Top Right side > PgUp
' Left Click Blank Bottom Left side > End
' Left Click Blank Bottom Right side > PgDn
' Right Click Box to select highlited, active control moves to next in index
' note this wont activate or change highlite, only selects highlited item.
' Helper Sub Split and function Join$ added to manipulate arrays into strings (Join) or strings into arrays (Split).
' The Split sub is used in DrwLst to separate ~ delimited string into an array for List Box to display.
' Also split text when need to find selected item.
' You can scroll lists with Mouse wheel!
' label box conType = 4 labels are sizable with Height and fit between (centered) x and x + w
'
' This is added for this appl ===============================================================================
' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< see end of Subs abd Functions for copy
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
'===========================================================================================================
'reset your colors here FC = ForeColor BC = Back Color All the RGB32() are right here in constans section!
Dim Shared As _Unsigned Long screenBC, BtnFC, BtnBC, TbFC, TbBC, LstFC, LstBC, LblFC
screenBC = _RGB32(160, 180, 160)
BtnFC = _RGB32(0, 0, 0)
BtnBC = _RGB32(250, 250, 250)
TbFC = _RGB32(180, 180, 255)
TbBC = _RGB32(0, 0, 128)
LstFC = _RGB32(255, 180, 180)
LstBC = _RGB32(190, 0, 0)
LblFC = _RGB32(0, 0, 68)
Type Control ' all are boxes with colors, 1 is active
As Long ConType, X, Y, W, H, N1, N2, N3, N4, N5 ' N1, N2 sometimes controls need extra numbers for special functions
' ID is actually index number same order as you enter NewControls
As String Text, Text2 ' dims are pixels Text2 is for future selected text from list box
' default wnd = 0, btn = 1, txtBx = 2, LstBx = 3
End Type
Dim Shared As Long Xmax, Ymax, NControls, ActiveControl, WindowClose ' new as long and WindowClose
ReDim Shared con(0) As Control
Dim As Long kh, mx, my, mb1, mb2, i, shift1, shift2, lc
'set your controls and labels ======================================================================== appl plug-in
Xmax = 1280: Ymax = 640 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Window size shared throughout program
OpenWindow Xmax, Ymax, "Test Very Simple GUI-2022-06-15" ' <<<<<<<< set your window screen size and title
Dim Shared curPath$ ' track where we are in navigation see GetListStrings
Dim Shared As Long LblPath, LblCurPath, LblDirs, LblFils, LstD, LstF, LblFile, LblSelFile, BtnOK, BtnKill, BtnCancel
Dim fils$, dirs$
GetListStrings dirs$, fils$
LblPath = NewControl(4, 0, 10, _Width, 20, "Current Folder:")
LblCurPath = NewControl(4, 0, 35, _Width, 16, curPath$)
LblDirs = NewControl(4, 150, 60, 300, 20, "Sub Directorys:")
LblFils = NewControl(4, 530, 60, 600, 20, "Files:")
LstD = NewControl(3, 150, 85, 300, 432, dirs$)
LstF = NewControl(3, 530, 85, 600, 432, fils$)
LblFile = NewControl(4, 0, 520, _Width, 20, "Selected File:")
LblSelFile = NewControl(4, 0, 550, _Width, 16, "Selected File goes here")
BtnOK = NewControl(1, 20, 580, 400, 50, "OK Run it.")
BtnCancel = NewControl(1, 440, 580, 400, 50, "Quit")
BtnKill = NewControl(1, 860, 580, 400, 50, "Kill it!")
' ========================================================================================================================
Do
' mouse clicks and tabs will decide the active control
While _MouseInput
If con(ActiveControl).ConType = 3 Then
If _MouseWheel > 0 Then
LstKeyEvent ActiveControl, 20480
ElseIf _MouseWheel < 0 Then
LstKeyEvent ActiveControl, 18432
End If
End If
Wend
mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If mb1 Then ' find which control
For i = 1 To NControls
If mx >= con(i).X And mx <= con(i).X + con(i).W Then
If my >= con(i).Y And my <= con(i).Y + con(i).H Then
If i <> ActiveControl And con(i).ConType <> 4 Then
activateControl ActiveControl, 0
ActiveControl = i
activateControl ActiveControl, -1
End If
Exit For
End If
End If
Next
If con(ActiveControl).ConType = 1 Then
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf con(ActiveControl).ConType = 2 Then ' move cursor to click point
If mx >= con(ActiveControl).X And mx <= con(ActiveControl).X + con(ActiveControl).W Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).H Then
con(ActiveControl).N1 = Int((mx - con(ActiveControl).X - 4) / 8) + 1
drwTB ActiveControl, -1
End If
End If
ElseIf con(ActiveControl).ConType = 3 Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + 16 Then ' top empty
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'home else pgUp
LstKeyEvent ActiveControl, 18176 ' home
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 18688 ' pgup
End If
ElseIf my >= con(ActiveControl).Y + con(ActiveControl).H - 16 And my <= con(ActiveControl).Y + con(ActiveControl).H Then ' bottom empty pgdn
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'end else pgDn
LstKeyEvent ActiveControl, 20224 ' end
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 20736 ' pgdn
End If
ElseIf my >= con(ActiveControl).Y + 16 And my < con(ActiveControl).Y + con(ActiveControl).H - 16 Then
con(ActiveControl).N2 = Int((my - con(ActiveControl).Y - 16) / 16) + 1
drwLst ActiveControl, -1
End If
End If
_Delay .2 ' user release key wait
End If
If mb2 Then ' use right clicking to select
If con(ActiveControl).ConType = 3 Then ' this does not make the lst active but if is can select the highlited
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, "~", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
_Delay .2
End If
End If
kh = _KeyHit
shift1 = _KeyDown(100304)
shift2 = _KeyDown(100303)
If kh = 9 Then 'tab
If shift1 Or shift2 Then
shiftActiveControl -1
Else
shiftActiveControl 1
End If
ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 3 Then
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, "~", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
End If
If con(ActiveControl).ConType = 2 Then
TBKeyEvent ActiveControl, kh ' this handles keypress in active textbox
If lc Mod 10 = 9 Then con(ActiveControl).N2 = 1 - con(ActiveControl).N2 ' this is for blinking cursor
If con(ActiveControl).N2 Then
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), &HFFFFFFFF, BF
Else
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), TbBC, BF
End If
ElseIf con(ActiveControl).ConType = 3 Then
LstKeyEvent ActiveControl, kh
End If
_Display
lc = lc + 1
_Limit 60
Loop Until WindowClose
System
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
End Select
End Sub
Sub OpenWindow (WinWidth As Long, WinHeight As Long, title$)
Screen _NewImage(WinWidth, WinHeight, 32)
_ScreenMove 70, 20
_PrintMode _KeepBackground
_Title title$
Color &HFFFFFFFF, screenBC
Cls
End Sub
Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H 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: drwBtn NControls, a
Case 2: drwTB NControls, a: con(NControls).N1 = Len(s$) + 1: con(NControls).N2 = 0
' N1 is what letter position we are on or cursor for line, N2 is the toggle for cursor blinking
Case 3: con(NControls).N3 = Int((W - 16) / 8) ' page width - .5 charcter margin on each side 1 char scroll click bar
con(NControls).N4 = Int((H - 32) / 16) ' page height 2 empty lines for page up, page down clicking
con(NControls).N1 = 1 ' page number
con(NControls).N2 = 1 ' select highlite bar
con(NControls).Text2 = "" ' zero everything out for UDT's
drwLst NControls, a
Case 4: drwLbl NControls
End Select
NewControl& = NControls ' same as ID
End Function
Sub drwBtn (i As Long, active As Long) ' gray back, black text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), BtnBC, BF
If active Then Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B Else _
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
Color BtnFC
_PrintString (con(i).X + (con(i).W - 8 * Len(con(i).Text)) / 2, (con(i).Y + (con(i).H - 16) / 2)), con(i).Text
End Sub
Sub drwTB (i As Long, active As Long) ' blue back, white text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), TbBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
Color TbFC
_PrintString (con(i).X + 4, con(i).Y + (con(i).H - 16) / 2), con(i).Text
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 s$
Dim As Long j
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), LstBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
ReDim lst(1 To 1) As String
Split con(i).Text, "~", lst()
con(i).N5 = UBound(lst)
For j = 1 To con(i).N4
s$ = Space$(con(i).N3)
If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
Mid$(s$, 1, con(i).N3) = lst((con(i).N1 - 1) * con(i).N4 + j)
End If
If j <> con(i).N2 Then
Color LstFC
Else
Line (con(i).X + 1, con(i).Y + 16 + (j - 1) * 16)-Step(con(i).W - 2, 16), LstFC, BF
Color LstBC
End If
_PrintString (con(i).X + 4, con(i).Y + 16 + (j - 1) * 16), s$
Next
End Sub
Sub drwLbl (i As Long)
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), screenBC, BF
Static beenHere, fontHandle&(6 To 64)
Dim As Long j
If beenHere = 0 Then
For j = 6 To 64
fontHandle&(j) = _LoadFont("ARLRDBD.ttf", j)
Next
beenHere = -1
End If
Dim As _Unsigned Long curFont
curFont = _Font
_Font fontHandle&(con(i).H)
Color LblFC, _RGB32(0, 0, 0, 0)
_PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y), con(i).Text
_Font curFont
End Sub
Sub BtnClickEvent (i As Long) ' attach you button click code in here
Dim answer$, dirs$, fils$ ' <<<<<<<<<<<<<<<<<< dim for click code
Select Case i
' according to your appl needs ================================================ for your appl
Case BtnOK: Shell _DontWait con(LblSelFile).Text ' hey run it!
Case BtnKill
answer$ = inputBox$(con(LblSelFile).Text, "Confirm Kill, enter y or n", _Width \ 8 - 7)
If answer$ = "y" Then
Kill con(LblSelFile).Text
GetListStrings dirs$, fils$
con(LstD).Text = dirs$
con(LstF).Text = fils$
con(LblSelFile).Text = ""
drwLbl LblSelFile
drwLst LstD, 0
drwLst LstF, 0
End If
Case BtnCancel: WindowClose = -1 ' goodbye
' ========================================================================= end plug-in
End Select
End Sub
' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long) ' for all text boxes
If ky = 19200 Then 'left arrow
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
ElseIf ky = 19712 Then ' right arrow
If con(i).N1 < Int((con(i).W - 16) / 8) Then con(i).N1 = con(i).N1 + 1: drwTB i, -1
ElseIf ky = 18176 Then 'home
con(i).N1 = 1: drwTB i, -1
ElseIf ky = 20224 Then ' end
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then con(i).N1 = Len(con(i).Text) + 1: drwTB i, -1
ElseIf ky >= 32 And ky <= 128 Then
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Chr$(ky) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 + 1: drwTB i, -1
End If
ElseIf ky = 8 Then 'backspace
If con(i).N1 > 1 Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 2) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 - 1: drwTB i, -1
End If
ElseIf ky = 21248 Then 'delete
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Mid$(con(i).Text, con(i).N1 + 1): drwTB i, -1
End If
End 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
Sub LstSelectEvent (control As Long)
Dim fils$, dirs$
Select Case control
' =================================================================================== for your appl
Case LstD
ChDir con(LstD).Text2
curPath$ = _CWD$
con(LblCurPath).Text = curPath$
drwLbl LblCurPath
GetListStrings dirs$, fils$
con(LstD).Text = dirs$
con(LstF).Text = fils$
con(LblSelFile).Text = ""
drwLbl LblSelFile
drwLst LstD, 0
drwLst LstF, -1 'should be active
Case LstF
con(LblSelFile).Text = curPath$ + "/" + con(LstF).Text2
drwLbl LblSelFile
' ================================================================================= end plug-in
End Select
End Sub
' This is used and available for maniupating strings to arrays ie change delimiters to commas
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
dpos = InStr(curpos, SplitMeString, delim)
Do Until dpos = 0
loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
arrpos = arrpos + 1
If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
curpos = dpos + LD
dpos = InStr(curpos, SplitMeString, delim)
Loop
loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
' Available if need to create a string from an array
Function Join$ (arr() As String, delimiter$) ' modified to avoid blank lines
Dim i As Long, b$
For i = LBound(arr) To UBound(arr)
If arr(i) <> "" Then
If b$ = "" Then b$ = arr(i) Else b$ = b$ + delimiter$ + arr(i)
End If
Next
Join$ = b$
End Function
' added to GUI - 2022-06-15 version ============================= Routines for this appl
' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
Function inputBox$ (prompt$, title$, boxWidth As Long) ' boxWidthin default 8x16 chars!!!
Dim ForeColor As _Unsigned Long, BackColor As _Unsigned Long
Dim sw As Long, sh As Long, curScrn As Long, backScrn As Long, ibx As Long 'some handles
'colors
ForeColor = &HFF000055 '< change as desired prompt text color, back color or type in area
BackColor = &HFF6080CC '< change as desired used fore color in type in area
'items to restore at exit
ScnState 0
'screen snapshot
sw = _Width: sh = _Height: curScrn = _Dest
backScrn = _NewImage(sw, sh, 32)
_PutImage , curScrn, backScrn
'moving box around on screen
Dim bxW As Long, bxH As Long
Dim mb As Long, mx As Long, my As Long, mi As Long, grabx As Long, graby As Long
Dim tlx As Long, tly As Long 'top left corner of message box
Dim lastx As Long, lasty As Long
Dim inp$, kh&
'draw message box
bxW = boxWidth * 8: bxH = 7 * 16
ibx = _NewImage(bxW, bxH, 32)
_Dest ibx
Color &HFF880000, &HFFFFFFFF
Locate 1, 1: Print Left$(Space$(Int((boxWidth - Len(title$) - 3)) / 2) + title$ + Space$(boxWidth), boxWidth)
Color &HFFFFFFFF, &HFFBB0000
Locate 1, boxWidth - 2: Print " X "
Color ForeColor, BackColor
Locate 2, 1: Print Space$(boxWidth);
Locate 3, 1: Print Left$(Space$((boxWidth - Len(prompt$)) / 2) + prompt$ + Space$(boxWidth), boxWidth);
Locate 4, 1: Print Space$(boxWidth);
Locate 5, 1: Print Space$(boxWidth);
Locate 6, 1: Print Space$(boxWidth);
inp$ = ""
GoSub finishBox
'convert to pixels the top left corner of box at moment
bxW = boxWidth * 8: bxH = 5 * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
_KeyClear
'now allow user to move it around or just read it
While 1
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
_Display
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
If mx >= tlx + bxW - 24 Then Exit While
grabx = mx - tlx: graby = my - tly
Do While mb 'wait for release
mi = _MouseInput: mb = _MouseButton(1)
mx = _MouseX: my = _MouseY
If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
'attempt to speed up with less updates
If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
tlx = mx - grabx: tly = my - graby
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
lastx = tlx: lasty = tly
_Display
End If
End If
_Limit 400
Loop
End If
End If
kh& = _KeyHit
Select Case kh& 'whew not much for the main event!
Case 13: Exit While
Case 27: inp$ = "": Exit While
Case 32 To 128: If Len(inp$) < boxWidth - 4 Then inp$ = inp$ + Chr$(kh&): GoSub finishBox Else Beep
Case 8: If Len(inp$) Then inp$ = Left$(inp$, Len(inp$) - 1): GoSub finishBox Else Beep
End Select
_Limit 60
Wend
'put things back
ScnState 1 'need fg and bg colors set to cls
Cls '? is this needed YES!!
_PutImage , backScrn
_Display
_FreeImage backScrn
_FreeImage ibx
ScnState 1 'because we have to call _display, we have to call this again
inputBox$ = inp$
Exit Function
finishBox:
_Dest ibx
Color BackColor, ForeColor
Locate 5, 2: Print Left$(" " + inp$ + Space$(boxWidth - 2), boxWidth - 2)
_Dest curScrn
Return
End Function
' for saving and restoring screen settins
Sub 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
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
Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
' Thanks SNcNeill ! for a cross platform method to get file and directory lists
'put this block in main code section of your program close to top
'' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
' FUNCTION load_dir& (s AS STRING)
' FUNCTION has_next_entry& ()
' SUB close_dir ()
' SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
'END DECLARE
Const IS_DIR = 1
Const IS_FILE = 2
Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
Dim nam$
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
If load_dir(SearchDirectory + Chr$(0)) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If (flags And IS_DIR) Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf (flags And IS_FILE) Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
End If
End If
Loop Until length = -1
'close_dir 'move to after end if might correct the multi calls problem
Else
End If
close_dir 'this might correct the multi calls problem
ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub
' Remove comments below and copy paste into text editor, save as direntry.h
' Save in your QB64.exe folder if you don't have it already
'============================================================= direntry.h copy but commented
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
' #define GetCurrentDir _getcwd
'#else
' #define GetCurrentDir getcwd
'#endif
'int load_dir (char * path) {
' struct dirent *pent;
' struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
'int has_next_entry () {
' next_entry = readdir(pdir);
' if (next_entry == NULL) return -1;
' stat(next_entry->d_name, &statbuf1);
' return strlen(next_entry->d_name);
'}
'void get_next_entry (char * nam, int * flags, int * file_size) {
' strcpy(nam, next_entry->d_name);
' if (S_ISDIR(statbuf1.st_mode)) {
' *flags = IS_DIR_FLAG;
' } else {
' *flags = IS_FILE_FLAG;
' }
' *file_size = statbuf1.st_size;
' return ;
'}
'void close_dir () {
' closedir(pdir);
' pdir = NULL;
' return ;
'}
'int current_dir_length () {
' GetCurrentDir(current_dir, sizeof(current_dir));
' return strlen(current_dir);
'}
'void get_current_dir(char *dir) {
' memcpy(dir, current_dir, strlen(current_dir));
' return ;
'}
Here is a screenshot of GUI Get Filename running some code with a bug in it ;-))
Linux might not have a problem with this, I used the other slanted slash to Join the path to the filename, see selected file label.
Wait does Linux do Shell?
b = b + ...