04-28-2022, 10:52 PM
FileSelect$ is a simple to use file selector function that you can use to list all files in the current directory and select a filename from that list. This is an updated version that allows user defined colors, so it's fully customizable now. The function pops up a scroll-able box, allows the user to navigate (using the keyboard) and select a file, and it returns that filename as a variable to use. The screen background is preserved. The program below contains an example of using the function. Tested under Windows and Linux.
(Personally I'd recommend Steve's file list routine over this one, but here's mine to play with anyway)
- Dav
(Personally I'd recommend Steve's file list routine over this one, but here's mine to play with anyway)
- Dav
Code: (Select All)
'==============
'FILESELECT.BAS v1.2
'==============
'A simple file selector box function.
'Coded by Dav for QB64, APR/2022
'NEW for v1.2: Added user defined colors.
'Works under windows & Linux (havent tested Mac).
'Works in text and graphical screen modes.
'
'Lists files in current directory in a scroll box.
'Use arrows, page up/down, home/end to navigate.
'ENTER selects highlighted filename, ESC cancels.
'Selecting a directory will navigate to that
'directory and list files under it.
'The background screen is preserved and restored.
'=== DEMO FOLLOWS...
SCREEN _NEWIMAGE(700, 500, 32)
_SCREENMOVE _MIDDLE
'=== draw a background
CLS , _RGB(32, 32, 32)
FOR x = 1 TO _WIDTH STEP 3
FOR y = 1 TO _HEIGHT STEP 3
PSET (x, y), _RGB(RND * 255, RND * 255, RND * 255)
NEXT
NEXT
PRINT "Use arrows to navigate to a filename. "
PRINT "Press ENTER to select highlighted file."
PRINT "Press ESC to cancel and close file box."
'=== Define filebox colors here...
fsborder& = _RGB(255, 0, 0) 'filebox order color
fsfile& = _RGB(255, 255, 255) 'filename color
fsdir& = _RGB(255, 255, 64) 'directories color
fsback& = _RGB(64, 0, 0) 'Background color
fshigh& = _RGB(255, 255, 128) 'highlighted line color
'=== Ask user to select a file
a$ = FileSelect$(5, 15, 20, 55, "*.*", fsborder&, fsback&, fsfile&, fsdir&, fshigh&)
'=== Show results...
PRINT
IF a$ <> "" THEN
PRINT "You selected: "; a$
ELSE
PRINT "No file selected."
END IF
END
FUNCTION FileSelect$ (y, x, y2, x2, Filespec$, fsborder&, fsback&, fsfile&, fsdir&, fshigh&)
'==============================================
'FileSelect$ function v1.2 by Dav, APR/2022
'==============================================
'This function returns a selected filename.
'Show files in current directory in a scroll box.
'Use arrows, page up/down, home/end to navigate.
'ENTER selects highlighted filename, ESC cancels.
'Selecting a directory will navigate to that dir
'and list files under that directory.
'The background screen is preserved and restored.
'y,x = top left of box
'y2,x2 = bottom right of box
'Filespec$ = spec of files to list in box ( do "*.*" for all)
'fsborder& = color of box border
'fsback& = background color of file box.
'fsfile& = color of filenames
'fsdir& = color of directories
'fshigh& = color of highlighted line
'=================================================
'=== save original place of cursor
origy = CSRLIN
origx = POS(1)
'=== save colors
fg& = _DEFAULTCOLOR
bg& = _BACKGROUNDCOLOR
'=== Save whole screen
DIM scr1 AS _MEM, scr2 AS _MEM
scr1 = _MEMIMAGE(0): scr2 = _MEMNEW(scr1.SIZE)
_MEMCOPY scr1, scr1.OFFSET, scr1.SIZE TO scr2, scr2.OFFSET
'=== Generate a unique temp filename to use based on date + timer
tmp$ = "_qb64_" + DATE$ + "_" + LTRIM$(STR$(INT(TIMER))) + ".tmp"
IF INSTR(_OS$, "LINUX") THEN tmp$ = "/tmp/" + tmp$
loadagain:
top = 0
selection = 0
'=== list directories
IF INSTR(_OS$, "LINUX") THEN
SHELL _HIDE "find . -maxdepth 1 -type d > " + tmp$
ELSE
SHELL _HIDE "dir /b /A:D > " + tmp$
END IF
'=== make room for names
REDIM FileNames$(10000) 'space for 10000 filenames
'=== only show the ".." when not at root dir
IF LEN(_CWD$) <> 3 THEN
FileNames$(0) = ".."
LineCount = 1
ELSE
LineCount = 0
END IF
'=== Open temp file
FF = FREEFILE
OPEN tmp$ FOR INPUT AS #FF
WHILE ((LineCount < UBOUND(FileNames$)) AND (NOT EOF(FF)))
LINE INPUT #FF, rl$
'=== load, ignoring the . entry added under Linux
IF rl$ <> "." THEN
'also remove the ./ added at the beginning when under linux
IF INSTR(_OS$, "LINUX") THEN
IF LEFT$(rl$, 2) = "./" THEN
rl$ = RIGHT$(rl$, LEN(rl$) - 2)
END IF
END IF
FileNames$(LineCount) = "[" + rl$ + "]"
LineCount = LineCount + 1
END IF
WEND
CLOSE #FF
'=== now grab list of files...
IF INSTR(_OS$, "LINUX") THEN
SHELL _HIDE "rm " + tmp$
IF Filespec$ = "*.*" THEN Filespec$ = ""
SHELL _HIDE "find -maxdepth 1 -type f -name '" + Filespec$ + "*' > " + tmp$
ELSE
SHELL _HIDE "del " + tmp$
SHELL _HIDE "dir /b /A:-D " + Filespec$ + " > " + tmp$
END IF
'=== open temp file
FF = FREEFILE
OPEN tmp$ FOR INPUT AS #FF
WHILE ((LineCount < UBOUND(FileNames$)) AND (NOT EOF(FF)))
LINE INPUT #FF, rl$
'=== load, ignoring the generated temp file...
IF rl$ <> tmp$ THEN
'also remove the ./ added at the beginning when under linux
IF INSTR(_OS$, "LINUX") THEN
IF LEFT$(rl$, 2) = "./" THEN
rl$ = RIGHT$(rl$, LEN(rl$) - 2)
END IF
END IF
FileNames$(LineCount) = rl$
LineCount = LineCount + 1
END IF
WEND
CLOSE #FF
'=== Remove the temp file created
IF INSTR(_OS$, "LINUX") THEN
SHELL _HIDE "rm " + tmp$
ELSE
SHELL _HIDE "del " + tmp$
END IF
'=== draw a box
COLOR fsborder&
FOR l = 0 TO y2 + 1
LOCATE y + l, x: PRINT STRING$(x2 + 4, CHR$(219));
NEXT
'=== show current working dir at top
COLOR fsfile&, fsborder&
CurDir$ = _CWD$
'=== Shorten it is too long, for display purposes
IF LEN(CurDir$) > x2 - x THEN
CurDir$ = MID$(CurDir$, 1, x2 - x - 3) + "..."
END IF
LOCATE y, x + 2: PRINT CurDir$;
'=== scroll through list...
DO
FOR l = 0 TO (y2 - 1)
LOCATE (y + 1) + l, (x + 2)
IF l + top = selection THEN
COLOR fsback&, fshigh& 'selected line
ELSE
COLOR fsfile&, fsback& 'regular
'=== directories get a different color...
IF MID$(FileNames$(top + l), 1, 1) = "[" THEN
COLOR fsdir&, fsback&
END IF
END IF
PRINT LEFT$(FileNames$(top + l) + STRING$(x2, " "), x2);
NEXT
'=== Get user input
k$ = INKEY$
SELECT CASE k$
CASE IS = CHR$(0) + CHR$(72) 'Up arrow
IF selection > 0 THEN selection = selection - 1
IF selection < top THEN top = selection
CASE IS = CHR$(0) + CHR$(80) 'Down Arrow
IF selection < (LineCount - 1) THEN selection = selection + 1
IF selection > (top + (y2 - 2)) THEN top = selection - y2 + 1
CASE IS = CHR$(0) + CHR$(73) 'Page up
top = top - y2
selection = selection - y2
IF top < 0 THEN top = 0
IF selection < 0 THEN selection = 0
CASE IS = CHR$(0) + CHR$(81) 'Page Down
top = top + y2
selection = selection + y2
IF top >= LineCount - y2 THEN top = LineCount - y2
IF top < 0 THEN top = 0
IF selection >= LineCount THEN selection = LineCount - 1
CASE IS = CHR$(0) + CHR$(71) 'Home
top = 0: selection = 0
CASE IS = CHR$(0) + CHR$(79) 'End
selection = LineCount - 1
top = selection - y2 + 1
IF top < 0 THEN top = 0
CASE IS = CHR$(27) ' ESC cancels
FileSelect$ = ""
EXIT DO
CASE IS = CHR$(13) 'Enter
'=== if .. then go up one dir
IF RTRIM$(FileNames$(selection)) = ".." THEN
cd$ = _CWD$
IF INSTR(_OS$, "LINUX") THEN
cd$ = LEFT$(cd$, _INSTRREV(cd$, "/"))
ELSE
cd$ = LEFT$(cd$, _INSTRREV(cd$, "\"))
END IF
CHDIR cd$
ERASE FileNames$
GOTO loadagain
END IF
'see if directory
test$ = RTRIM$(FileNames$(selection))
IF LEFT$(test$, 1) = "[" THEN
test$ = MID$(test$, 2, LEN(test$) - 2)
CHDIR test$
ERASE FileNames$
GOTO loadagain
ELSE
IF INSTR(_OS$, "LINUX") THEN
IF RIGHT$(_CWD$, 1) = "/" THEN
C$ = _CWD$
ELSE
C$ = _CWD$ + "/"
END IF
ELSE
IF RIGHT$(_CWD$, 1) = "\" THEN
C$ = _CWD$
ELSE
C$ = _CWD$ + "\"
END IF
END IF
FileSelect$ = C$ + RTRIM$(FileNames$(selection))
EXIT DO
END IF
END SELECT
LOOP
_KEYCLEAR
'=== Restore the whole screen
_MEMCOPY scr2, scr2.OFFSET, scr2.SIZE TO scr1, scr1.OFFSET
_MEMFREE scr1: _MEMFREE scr2
'=== restore original y,x and color
LOCATE origy, origx
COLOR fg&, bg&
END FUNCTION