The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

martha my dir

October 11 2005 at 4:31 AM
mennonite  (no login)

 

'file selection in screen 0 (to make this work in other screen modes remove ", back" or ", fore" from any color statements)
'2005 mennonite (public domain)

DIM filename$(1 TO 500)
limit = 500 'works with a maximum of 500 files, it won't show the 501st one.

tempfile$ = "temp.tmp"

fore = 7: back = 0
COLOR fore, back: CLS

GOSUB usedircmd 'update this program's file data

'draw box
LOCATE 2, 2: PRINT CHR$(218) + STRING$(32, 196) + CHR$(191)
FOR p = 1 TO 21: PRINT SPACE$(1) + CHR$(179) + SPACE$(32) + CHR$(179): NEXT p
PRINT SPACE$(1) + CHR$(192) + STRING$(32, 196) + CHR$(217);
LOCATE 4, 2: PRINT CHR$(195) + STRING$(32, 196) + CHR$(180)

LOCATE 3, 3: PRINT SPACE$(32)
LOCATE 3, 3: PRINT LEFT$(path$ + SPACE$(32), 32)

absoindex = 1 'the highlighter location, min 1, max 19
listref = 1 'the point in the list to start printing, min 1, max (limit-19ish)

GOSUB seelist: GOSUB highlight

DO
DO: i$ = INKEY$: LOOP UNTIL i$ <> ""
IF LEN(i$) > 1 THEN MID$(i$, 1, 1) = CHR$(255) 'fb arrows compatibility in qb
SELECT CASE LCASE$(i$)
CASE CHR$(13)
IF INSTR(filename$(listref - 1 + absoindex), "<dir>") THEN
'...then change directory and relist
fi$ = RTRIM$(filename$(listref - 1 + absoindex))
quot$ = ""
IF INSTR(RIGHT$(fi$, LEN(fi$) - 6), SPACE$(1)) THEN quot$ = CHR$(34)
SHELL "chdir " + quot$ + LTRIM$(RIGHT$(fi$, LEN(fi$) - 5)) + quot$
absoindex = 1: listref = 1: GOSUB usedircmd: GOSUB seelist: GOSUB highlight
i$ = SPACE$(1) 'cancel. file is not selected, folder changed
LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
PRINT LEFT$(path$ + SPACE$(32), 32)
END IF
selection$ = filename$(listref - 1 + absoindex)
CASE CHR$(27)
GOSUB quitprogram
CASE CHR$(255) + "h" 'in this case, (sic) "up"
IF absoindex > 1 THEN
absoindex = absoindex - 1: GOSUB seelist: GOSUB highlight
ELSE
IF listref > 1 THEN listref = listref - 1: GOSUB seelist: GOSUB highlight
END IF
IF filec THEN LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
IF filec THEN PRINT "file"; listref - 1 + absoindex; "of"; filec
CASE CHR$(255) + "p" 'down
IF listref - 1 + absoindex < filec THEN
IF absoindex < 19 THEN
absoindex = absoindex + 1
ELSE
listref = listref + 1
END IF
GOSUB seelist: GOSUB highlight
END IF
IF filec THEN LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
IF filec THEN PRINT "file"; listref - 1 + absoindex; "of"; filec
CASE CHR$(255) + "k" 'left
IF listref + 1 - 19 >= 1 THEN
listref = listref + 1 - 19: GOSUB seelist: GOSUB highlight
END IF
IF filec THEN LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
IF filec THEN PRINT "file"; listref - 1 + absoindex; "of"; filec
CASE CHR$(255) + "m" 'right
IF listref - 1 + 19 <= filec + 1 - 19 THEN
listref = listref - 1 + 19: GOSUB seelist: GOSUB highlight
END IF
IF filec THEN LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
IF filec THEN PRINT "file"; listref - 1 + absoindex; "of"; filec
CASE ELSE
LOCATE 3, 3: PRINT SPACE$(32): LOCATE 3, 3
PRINT LEFT$(path$ + SPACE$(32), 32)
END SELECT
LOOP UNTIL i$ = CHR$(13)

CLOSE

CLS
PRINT "the current path is: [" + path$ + "]"
PRINT "your filename is: [" + selection$ + "]": SLEEP 4
SHELL "copy " + selection$ + SPACE$(1) + tempfile$ + " > nul"
OPEN tempfile$ FOR INPUT AS #1
FOR qq = 1 TO 20
IF NOT EOF(1) THEN
LINE INPUT #1, semiline$
't = TIMER + .7: DO: LOOP UNTIL TIMER > t OR TIMER < t - .8
LOCATE qq + 3, 1: PRINT LEFT$(semiline$ + SPACE$(80), 80)
END IF
NEXT qq
CLOSE : GOSUB quitprogram

END

seelist:
LOCATE 5, 3: IF listref = 0 THEN listref = 1
FOR q = listref TO listref + 18: LOCATE , 3: PRINT SPACE$(32)
NEXT q
LOCATE 5, 3: IF listref = 0 THEN listref = 1
FOR q = listref TO listref + 18
IF q > filec THEN EXIT FOR
LOCATE , 3: PRINT LEFT$(filename$(q) + SPACE$(32), 32)
NEXT q
RETURN

quitprogram:
CLOSE
COLOR 7, 0
SYSTEM 'you forgot SYSTEM!' - phylo
END

highlight:
FOR xl = 3 TO 3 - 1 + 32: IF absoindex = 0 THEN absoindex = 1
ch = SCREEN(absoindex + 4, xl)
COLOR back, fore
LOCATE absoindex + 4, xl: PRINT CHR$(ch)
NEXT xl: COLOR fore, back
RETURN

usedircmd:
filec = 0 'reset
SHELL "cd > " + tempfile$
SHELL "if exist ..\nul echo .. >> " + tempfile$ 'allow parent folder
'/no fileinfo,/all directories (hidden too) (directories=subdirs=folders)
SHELL "dir /b /ad >> " + tempfile$
'CLS : SHELL "type " + tempfile$: END
OPEN tempfile$ FOR INPUT AS #1
LINE INPUT #1, path$
path$ = path$ + LEFT$("\", ABS(RIGHT$(path$, 1) <> "\"))
DO
IF NOT EOF(1) THEN
LINE INPUT #1, filename$(filec + 1)
IF LEN(LTRIM$(filename$(filec + 1))) THEN filec = filec + 1
filename$(filec) = "<dir> " + filename$(filec)
END IF
LOOP UNTIL EOF(1) OR (filec >= limit)
CLOSE #1
'/no fileinfo,/all files (hidden too) but no directories
SHELL "dir /b /a-d > " + tempfile$
OPEN tempfile$ FOR INPUT AS #1
DO
IF NOT EOF(1) THEN LINE INPUT #1, filename$(filec + 1): filec = filec + 1
LOOP UNTIL EOF(1) OR filec >= limit
CLOSE #1
RETURN

 
 Respond to this message   
Response TitleAuthor and Date
@%!# (a couple things...) (View Thread)mennonite on Oct 11
   >"but then you have to change all of them back to chr$(32)" on Oct 11
      "They should change automatically."mennonite on Oct 11
         Mennonite's program indented in my usual style, for those who care. on Oct 19
            *Still too much indentation for me, but sooooo much better than most. LOL.Pete on Oct 19
new version works in 9x, me, 2k?, xp. (includes F1 and BACKspace) (View Thread)mennonite on Oct 19
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums