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

Mennonite's program indented in my usual style, for those who care.

October 19 2005 at 10:33 PM
  (Login MCalkins)
R


Response to "They should change automatically."

'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
*Still too much indentation for me, but sooooo much better than most. LOL. (View Thread)Pete on Oct 19

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