home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / QWEZ60.ZIP / DEMPART2.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-11-11  |  22.0 KB  |  557 lines
  1. '!!! ---------------------------------------------------------------------!!!
  2. '!!!   NOTE: THIS MODULE MUST BE LOADED WITH DEMO.BAS AS THE MAIN MODULE  !!!
  3. '!!! ---------------------------------------------------------------------!!!
  4.  
  5. '----------  MUST BE IN ANY MODULE USING "FINDDIR" DIRECTORY ROUTINE --------
  6. TYPE DIREC
  7.   SIZE AS LONG              ' SIZE
  8.   DATE AS STRING * 10       ' DATE
  9.   TIME AS STRING * 6        ' TIME
  10.   ATTR AS INTEGER           ' ATTRIBUTE
  11. END TYPE
  12. COMMON SHARED /DIRECTORY/ DIREC$(), DIRINFO() AS DIREC
  13. '----------------------------------------------------------------------------
  14. DECLARE SUB B4INPT (INPTEXIT$, RESTRICT$)
  15. DECLARE SUB B4SCRL (EXIT$, MARK$, TAGCOL%, NOREFRESH%)
  16. DECLARE SUB BOXW (TR%, LC%, WD%, NR%, BORDER%)
  17. DECLARE FUNCTION CHOICEBAR% (CHOICE$(), TR%, LC%, WD%, ATTR%, HATTR%, EXIT$)
  18. DECLARE FUNCTION CHOICEWIND% (TITLE$, TX$(), CH$(), TR%, LC%, ATTR%, HCOL%, ESCEXIT%, BORDER%)
  19. DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
  20. DECLARE SUB CHNGWIND (W%)
  21. DECLARE SUB CLRWIND ()
  22. DECLARE SUB CUROFF ()
  23. DECLARE SUB DELWIND (W%)
  24. DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
  25. DECLARE SUB DOSOUND ()
  26. DECLARE FUNCTION FINDPATH$ ()
  27. DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
  28. DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, WATTR%, FATTR%, BORDER%)
  29. DECLARE FUNCTION GETCUR& ()
  30. DECLARE FUNCTION GETDISK% ()
  31. DECLARE SUB INFOFIXED (FIXED$)
  32. DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
  33. DECLARE SUB INPTINIT (DTYPE%, ISDOT%, STARTAT1%, NOBLANK%, SND%)
  34. DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, WATTR%, FATTR%, RTRN$, RK%, BUT%, BRD%)
  35. DECLARE FUNCTION GETAKEY% ()
  36. DECLARE FUNCTION LBUTTON% ()
  37. DECLARE SUB LINEW (ROW%, TYP%)
  38. DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
  39. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  40. DECLARE FUNCTION MARKED% (RTRN$, START%)
  41. DECLARE FUNCTION MOUSECOL% ()
  42. DECLARE SUB MOUSEINIT ()
  43. DECLARE FUNCTION MOUSEINMULT% (MULTSCRN%)
  44. DECLARE FUNCTION MOUSEINWIND% (WIND%)
  45. DECLARE SUB MOUSELIMITS (TROW%, BROW%, LCOL%, RCOL%)
  46. DECLARE FUNCTION MOUSEON% (ONFLAF%)
  47. DECLARE SUB MOUSEPOS (ROW%, COL%)
  48. DECLARE FUNCTION MOUSEROW% ()
  49. DECLARE SUB MOUSESHOW ()
  50. DECLARE SUB MULTINPT (SCRN%, TOFLD%, OPT$, FROMFLD%, RKEY%, RTRN$(), SELFLD%)
  51. DECLARE SUB NEWCOLOR (ATTR%)
  52. DECLARE FUNCTION PEEKASM& (S&, O&, BYVAL N%)
  53. DECLARE SUB PRINTINFO (I$)
  54. DECLARE SUB PRINTW (TEXT$, TR%, LC%)
  55. DECLARE SUB PRINTWHOT (TEXT$, TR%, LC%, HOTCHAR%, ATTR%)
  56. DECLARE SUB PULLDOWN (INFO$(), A%, B%, EXIT$, RKEY%, ATTR%, HATTR%, BORDER%)
  57. DECLARE FUNCTION RBUTTON% ()
  58. DECLARE SUB RESAVE ()
  59. DECLARE SUB RSTRINFO (DELFLAG%)
  60. DECLARE SUB RSTRINPT (DELFLAG%)
  61. DECLARE SUB RSTRPULL (RSTRMBAR%)
  62. DECLARE SUB RSTRWIND (W%, DELFLAG%)
  63. DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
  64. DECLARE SUB SCRLWIND (LIST$(), INFO$(), TOPLINE$, ENTRIES%, RTRN$, RTRN%, LI%, FC%, RKEY%, HIATTR%, SCROLLBAR%, BUT%)
  65. DECLARE SUB SETCUR (C&)
  66. DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
  67. DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
  68. DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
  69. DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%, NOHIGH%, BRACKETATTR%)
  70. DECLARE SUB UPDATEFIELD (SCRN%, FLD%, TEXT$)
  71. DECLARE FUNCTION WAVAIL% (W%)
  72. DECLARE SUB WINDSTATUS ()
  73. '---------------------------------------------------------------------------
  74. DECLARE FUNCTION COL% (A%)
  75. DECLARE SUB PRINTFILEINFO ()
  76. DECLARE FUNCTION FINDDRV% ()
  77. DECLARE FUNCTION FINDSUB% ()
  78. DECLARE FUNCTION FINDFILE% ()
  79. DECLARE SUB MESSAGE (M%)
  80.  
  81.  
  82. DIM SHARED PATH$, OLDPATH$, FOUNDFILE$, OLDDR%, MODE$, I$(0), SPEC$
  83. DIM SHARED DISKERROR%, NUMFILES%, NUMSUBS%, LASTGOODPATH$, WASERR%
  84. DIM SHARED FIL$(X%), SUBDIR$(X%)
  85.  
  86. DERROR:
  87.   CALL MESSAGE(0)
  88.   SELECT CASE ERR
  89.     CASE 24, 57, 71, 72
  90.       E$ = "DISK ERROR"
  91.     CASE 52, 64, 75, 76
  92.       E$ = "FILE SPEC ERROR"
  93.     CASE ELSE
  94.   END SELECT
  95.   REDIM C$(2), T$(0)
  96.   C$(1) = "Retry": C$(2) = "Abort"
  97.   A% = COL%(31)
  98.   X% = CHOICEWIND%("@        " + E$ + "        ", T$(), C$(), 7, 100, A%, 0, 0, 112)
  99.   IF X% = 1 THEN CALL MESSAGE(1): RESUME
  100.   DISKERROR% = 1: WASERR% = ERR: RESUME NEXT
  101.  
  102. SUB CHOICEDEMO
  103.   A% = COL%(31): IF A% = 15 THEN A% = 112: B% = 127 ELSE B% = 28
  104.   PRINTINFO " TAB to a selection and press ENTER or the SPACE BAR or use the MOUSE."
  105.   REDIM C$(5), T$(10)
  106.   FOR X% = 65 TO 69: C$(X% - 64) = CHR$(X%) + LCASE$(STRING$(5, X%)): NEXT
  107.   T$(1) = " 1. One to ten choices are permitted."
  108.   T$(2) = " 2. The windows width and length are automatically set."
  109.   T$(3) = " 3. Hot characater selection is available."
  110.   T$(4) = " 4. The area under the choice window is saved and restored on exit"
  111.   T$(5) = " 5. Selection can be made via the keyboard or the MOUSE."
  112.   T$(6) = " 6. Segmenting lines are permitted."
  113.   T$(7) = "-"
  114.   T$(9) = "@** Text can be automatically centered **"
  115.  
  116.   J% = CHOICEWIND%("@** Choice Window **", T$(), C$(), 100, 100, A%, B%, 1, 111)
  117.   IF J% <> 27 THEN
  118.     REDIM C$(1), T$(1)
  119.     PRINTINFO " Select OK...."
  120.     C$(1) = "OK": T$(1) = "@" + CHR$(J% + 64) + LCASE$(STRING$(5, J% + 64))
  121.     J% = CHOICEWIND%("   Your choice was...   ", T$(), C$(), 100, 100, 112, 0, 1, 112)
  122.   END IF
  123. END SUB
  124.  
  125. FUNCTION FINDDRV% STATIC
  126.  
  127. '---------------------------------------------------------------------------
  128. ' look for drives only on first pass through this function
  129.  
  130.  IF PASS% = 0 THEN                           ' 1st pass only
  131.    DR$ = SPACE$(26)                          ' room for 26 drive letters
  132.    EQUIP& = PEEKASM&(64, 16, 2)              ' to see if B: is installed
  133.    IF (EQUIP& AND 1) = 1 THEN
  134.       IF 1 + (EQUIP& AND 192) / 64 = 1 THEN NOB% = 66 ' NOB%=66 if no B: drv
  135.    END IF
  136.    DRIVES% = 0                                 ' counter for number of drives
  137.    FOR X% = 65 TO 90                           '
  138.      IF X% <> NOB% THEN                        ' skip if X%=2 and NOB%=2
  139.        CALL SETDISK(X% - 64, BAD%)             ' check for valid drive
  140.        IF BAD% <> 1 THEN                       ' not valid - no more checks
  141.           DRIVES% = DRIVES% + 1                ' increment drive counter
  142.           MID$(DR$, DRIVES%, 1) = CHR$(X%)     ' place drive letter in DR$
  143.        END IF
  144.      END IF
  145.    NEXT
  146.    REDIM DRV$(DRIVES%)                          ' DIM to number of drives
  147.    FOR X% = 1 TO DRIVES%
  148.      DRV$(X%) = "[-" + MID$(DR$, X%, 1) + "-]"  ' make scroll window list
  149.    NEXT
  150.    CALL SETDISK(OLDDR%, B%)           ' make original default drive active
  151.  END IF
  152. '---------------------------------------------------------------------------
  153. DO
  154.   CHNGWIND 3                                    ' this scroll window active
  155.   CALL B4SCRL("EOMCRT", "", 0, 0)               ' set exit keys
  156.   CALL SCRLWIND(DRV$(), I$(), "", DRIVES%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  157.  
  158.   IF RKEY% = 13 THEN
  159.      ' ENTER or double MOUSE click
  160.  
  161.     ' make selected drivv active
  162.     CALL SETDISK(ASC(MID$(DRV$(RTRN%), 3, 1)) - 64, B%)
  163.  
  164.     ON ERROR GOTO DERROR                                 ' for FINDPATH$
  165.     CALL MESSAGE(1)                                      ' reading message
  166.     PATH$ = FINDPATH$                                    ' get drive path
  167.     ON ERROR GOTO 0
  168.     IF DISKERROR% = 1 THEN                               ' disk error
  169.        DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION     ' abort selected
  170.     END IF
  171.     IF PATH$ <> OLDPATH$ THEN
  172.       ' new drive was selected so there is different path
  173.  
  174.       ON ERROR GOTO DERROR                               ' about to read disk
  175.       DISKSIZE ASC(PATH$) - 64, DISKSZE&, FREESPACE&     ' get disk info
  176.       ON ERROR GOTO 0
  177.       IF DISKERROR% = 1 THEN                             ' disk error
  178.          DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION   ' abort selected
  179.       END IF
  180.       CHNGWIND 4                                         ' full screen window
  181.       P$ = SPACE$(15): P1$ = P$
  182.       LSET P$ = STR$(DISKSZE&)
  183.       LSET P1$ = STR$(FREESPACE&)
  184.       CALL PRINTW(P$, 17, 21)                            ' print disk bytes
  185.       CALL PRINTW(P1$, 17, 61)                           ' print free bytes
  186.       MODE$ = "NV"                     ' view - exit with scroll bar ereasd
  187.       J% = FINDFILE%                   ' find the files
  188.       J% = FINDSUB%                    ' find the sub directories
  189.       MODE$ = "N"                      ' mode back to not view only
  190.       CALL PRINTFILEINFO               ' erases any displayed file info
  191.       OLDPATH$ = PATH$                 ' to check for future path changes
  192.     END IF
  193.     CALL MESSAGE(0)                    ' erase "reading" message
  194.   END IF
  195. LOOP WHILE RKEY% = 13
  196.  
  197. FINDDRV% = RKEY%                       ' "exit" key in FINDDRV%
  198.  
  199. END FUNCTION
  200.  
  201. FUNCTION FINDFILE% STATIC
  202.  
  203. RKEY% = 0                                ' no exit key
  204. DO
  205.   CHNGWIND 1                             ' make this the active window
  206.   IF OLDPATH$ <> PATH$ THEN
  207.      ' only if the path has changed
  208.  
  209.      FOUNDFILE$ = ""                     ' new path no selected file
  210.      IF LEN(PATH$) = 3 THEN              ' must be A:\, B:\, C:\ ect.
  211.         add$ = SPEC$                     ' add spec from File Spec: box
  212.      ELSE                                ' must not be root
  213.         add$ = "\" + SPEC$               ' add "\" + spec
  214.      END IF
  215.      ON ERROR GOTO DERROR
  216.      CALL FINDDIR(PATH$ + add$, "AHSROL", NFIL%)   ' find all files
  217.      ON ERROR GOTO 0
  218.      IF DISKERROR% = 1 THEN              ' was a disk error
  219.        PATH$ = LASTGOODPATH$             ' restore last good path
  220.        DISKERROR% = 0: FINDFILE% = 100: EXIT FUNCTION   ' abort selected
  221.      END IF
  222.      FIL% = NFIL%                     ' FIL% = number of found files
  223.      NUMFILES% = FIL%                 ' NUMFILES% shared with GETFILE
  224.      NR% = 0                          ' tells B4SCRL refresh the scroll wind
  225.      RTRN% = 1                        ' start on first file
  226.      LI% = 1                          ' on line 1
  227.      CLRWIND                          ' clear the scroll window
  228.      REDIM FIL$(FIL%)                 ' make scroll window entries.
  229.      FOR X% = 1 TO FIL%
  230.       SWAP FIL$(X%), DIREC$(X%)       ' "       "
  231.      NEXT
  232.      ERASE DIREC$                     ' get the memory back
  233.   ELSE                                ' no new path.
  234.      NR% = 1                          ' tell B4SCRL no need to refresh wind
  235.   END IF
  236.  
  237.   IF FIL% <> 0 THEN
  238.     ' only if there are files
  239.  
  240.     ' set exit keys - determine if scroll window is refreshed. enter scroll wind
  241.      CALL B4SCRL("OEMCRT", "", 0, NR%)
  242.      CALL SCRLWIND(FIL$(), I$(), "", FIL%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  243.  
  244.      IF RKEY% = 13 THEN
  245.        ' ENTER selected or double MOUSE click
  246.  
  247.        CALL PRINTFILEINFO                      ' erase last selected file info
  248.        FOUNDFILE$ = FIL$(RTRN%)                ' new selected file
  249.        CHNGWIND 4                              ' full screen window active
  250.        P$ = SPACE$(12)
  251.        P1$ = P$
  252.        LSET P$ = FOUNDFILE$
  253.        CALL PRINTW(P$, 5, 8)                   ' print file name
  254.        LSET P1$ = STR$(DIRINFO(RTRN%).SIZE)
  255.        CALL PRINTW(P1$, 5, 31)                 ' print file size
  256.        CALL PRINTW(DIRINFO(RTRN%).DATE, 5, 50) ' print file date
  257.        CALL PRINTW(DIRINFO(RTRN%).TIME, 5, 69) ' print file time
  258.      END IF
  259.   END IF
  260. LOOP WHILE RKEY% = 13
  261.  
  262. FINDFILE% = RKEY%                               ' "exit" key in FINDFILE%
  263.  
  264. END FUNCTION
  265.  
  266. FUNCTION FINDSUB% STATIC
  267.  
  268. RKEY% = 0                                      ' no exit key
  269. GOSUB GETSUBS                                  ' get any sub directories
  270.  
  271. DO
  272.   CHNGWIND 2                                   ' make this window active
  273.   IF NR% = 0 THEN CLRWIND                      ' clear it if to be refreshed
  274.   IF SUBDIR% <> 0 THEN
  275.      ' sub GETSUBS found some subs
  276.  
  277.      ' set exit keys and determine if window is to be refreshed - enter wind
  278.      CALL B4SCRL("OEMCRT", "", 0, NR%)
  279.      CALL SCRLWIND(SUBDIR$(), I$(), "", SUBDIR%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  280.  
  281.      IF RKEY% = 13 THEN
  282.         ' ENTER selected or double MOUSE click
  283.  
  284.         IF SUBDIR$(RTRN%) = ".." THEN
  285.           ' go "up" the dir tree
  286.  
  287.           DO
  288.             PATH$ = LEFT$(PATH$, LEN(PATH$) - 1)
  289.             IF LEN(PATH$) = 3 THEN EXIT DO
  290.             IF RIGHT$(PATH$, 1) = "\" THEN
  291.               PATH$ = LEFT$(PATH$, LEN(PATH$) - 1)
  292.               EXIT DO
  293.             END IF
  294.           LOOP
  295.         ELSE
  296.           'add selected dir to existing to existing path
  297.  
  298.           IF LEN(PATH$) > 3 THEN add$ = "\" ELSE add$ = ""
  299.           PATH$ = PATH$ + add$ + SUBDIR$(RTRN%)
  300.         END IF
  301.         CALL MESSAGE(1)           ' "reading" message
  302.         GOSUB GETSUBS             ' find subs based on selection
  303.         MODE$ = "NV"              ' call to FINDFILE% is view only
  304.         J% = FINDFILE%            ' get the files for the new path
  305.         CALL MESSAGE(0)           ' erase the message
  306.         MODE$ = "N"               ' mode no longer view only
  307.         CALL PRINTFILEINFO        ' erase any exiting file infp
  308.         OLDPATH$ = PATH$
  309.      END IF
  310.   END IF
  311. LOOP WHILE RKEY% = 13
  312.  
  313. FINDSUB% = RKEY%                  ' return with "exit" key in FINDSUB%
  314.  
  315. EXIT FUNCTION
  316.  
  317. '---------------------------------------------------------------------------
  318. ' get any sub directories
  319.  
  320. GETSUBS:
  321.  IF PATH$ <> OLDPATH$ THEN
  322.    ' only if the path has changed
  323.  
  324.    IF LEN(PATH$) = 3 THEN             ' must be A:\, B:\ etc...
  325.      add$ = ""                        ' add nothing
  326.    ELSE                               ' not the root
  327.      add$ = "\*.*"                    ' add "\*.*"
  328.    END IF
  329.    ON ERROR GOTO DERROR
  330.    CALL FINDDIR(PATH$ + add$, "D", F%)   ' find all dirs
  331.    ON ERROR GOTO 0
  332.    IF DISKERROR% = 1 THEN                ' was a disk error
  333.       DISKERROR% = 0: FINDSUB% = 100     ' abort was selected
  334.       PATH$ = OLDPATH$                   ' error, so restore the old path
  335.       EXIT FUNCTION                      ' and get ot
  336.    END IF
  337.    LASTGOODPATH$ = PATH$                 ' save the path
  338.    IF F% > 0 THEN
  339.      ' dirs were found
  340.  
  341.      IF DIREC$(1) = "." THEN
  342.         SUBDIR% = F% - 1: START% = 2     ' not using the root dir
  343.      ELSE
  344.         SUBDIR% = F%: START% = 1         ' path was changed to root dir
  345.      END IF
  346.      REDIM SUBDIR$(SUBDIR%)              ' to hold sub-directories
  347.      Y% = 1
  348.      FOR X% = START% TO F%
  349.         SWAP SUBDIR$(Y%), DIREC$(X%)     ' put sub dirs in SUBDIR%()
  350.         Y% = Y% + 1
  351.      NEXT
  352.      ERASE DIREC$                        ' get the memory back
  353.    ELSE
  354.      SUBDIR% = 0                         ' no sub dirs found
  355.    END IF
  356.    NUMSUBS% = SUBDIR%                    ' for GETFILE%
  357.    NR% = 0                               ' tell B4SCRL to refresh wind
  358.    RTRN% = 1                             ' start on first entry
  359.  ELSE
  360.    NR% = 1                               ' no new path - don't refresh wind
  361.  END IF
  362. RETURN
  363.  
  364. END FUNCTION
  365.  
  366. SUB GETFILE (P$, F$, RKEY%) STATIC
  367.  
  368.   WASERROR% = 0                          ' start no errors
  369.   A% = COL%(31)                          ' color or b/w
  370.   CALL MAKEWIND(4, "@[ Select a file ]", 1, 1, 80, 25, 112, 102)
  371.   OLDDR% = GETDISK%                      ' save existing default drive
  372.   ON ERROR GOTO DERROR
  373.   PATH$ = FINDPATH$                      ' get existing path
  374.   DISKSIZE OLDDR%, DISKSZE&, FREESPACE&  ' and existing disk size/ free space
  375.   ON ERROR GOTO 0
  376.   IF DISKERROR% = 1 THEN                 ' was a disk error
  377.     DISKERROR% = 0                       ' abort was selected
  378.     GOTO GETOUT
  379.   END IF
  380.   CALL PRINTW("DISK BYTES:" + STR$(DISKSZE&), 17, 10)   ' print disk bytes
  381.   CALL PRINTW("FREE BYTES:" + STR$(FREESPACE&), 17, 50) ' print free bytes
  382.  
  383.   CALL PRINTW("Path:", 4, 2)             ' print in full screen window
  384.   CALL PRINTW("File:", 5, 2)             ' "
  385.   CALL PRINTW("Bytes:", 5, 25)           ' "
  386.   CALL PRINTW("Date:", 5, 44)            ' "
  387.   CALL PRINTW("Time:", 5, 63)            ' "
  388.   CALL LINEW(18, 1)                      ' "
  389.   CALL LINEW(20, 1)                      ' "
  390.   '-------------------------------------------------------------------------
  391.   ' make the three windows to be used as scroll windows
  392.  
  393.   CALL MAKEWIND(1, "@Files", 10, 10, 16, 9, A%, 101)
  394.   CALL MAKEWIND(2, "@Directories", 10, 36, 16, 9, A%, 101)
  395.   CALL MAKEWIND(3, "@Drives", 10, 61, 10, 9, A%, 101)
  396.  
  397.   '-------------------------------------------------------------------------
  398.   ' print/update scroll windows -- print choicebar
  399.  
  400.   SPEC$ = "*.*"              ' start with all files
  401.   GOSUB UPDATEALL            ' update scroll windows and choice bar
  402.   WASERR% = 0
  403.   '-------------------------------------------------------------------------
  404.   LOOKIN% = 1                ' start in FILE SPEC: input window
  405.  
  406.   ' for info-line
  407.   I$ = " Press ENTER of DOUBLE CLICK MOUSE to select.   Press tab to move."
  408.  
  409. DO
  410.   SELECT CASE LOOKIN%
  411.  
  412.     CASE 1               ' file spec input window
  413.       CALL PRINTINFO(" Enter a file spec. ( EX: *.BAS / *.DOC ).  ENTER accepts - TAB moves.")
  414.       GOSUB GETSPEC
  415.       IF RKEY% = 14 OR RKEY% = 15 THEN LOOKIN% = 2  ' TAB or SHIFT+TAB
  416.  
  417.     CASE 2               ' files scroll window
  418.       INFOFIXED I$
  419.       GOSUB GETFILES
  420.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 3   ' TAB "view" or no entries
  421.       IF RKEY% = 14 THEN LOOKIN% = 1                ' SHIFT/TAB
  422.  
  423.     CASE 3               ' directory scroll window
  424.       INFOFIXED I$
  425.       GOSUB GETDIRS
  426.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 4   ' TAB "view" or no entries
  427.       IF RKEY% = 14 THEN LOOKIN% = 2                ' SHIFT/TAB
  428.  
  429.     CASE 4               ' drives scroll window
  430.       INFOFIXED I$
  431.       GOSUB GETDRVS
  432.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 5   ' TAB "view" or no entries
  433.       IF RKEY% = 14 THEN LOOKIN% = 3                ' SHIFT/TAB
  434.  
  435.     CASE 5               ' < OK >, < CANCEL > choicebar
  436.       CALL PRINTINFO(" Select OK to accept or CANCEL to cancel.")
  437.       GOSUB GETCHOICE
  438.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 1   ' TAB or "view"
  439.       IF RKEY% = 14 THEN LOOKIN% = 4                ' SHIFT/TAB
  440.   END SELECT
  441.  
  442.   INFOFIXED ""           ' erase infoline fixed string
  443.  
  444.   ' rkey% = 200 if left mouse button pressed out of window, field or choicebar.
  445.   IF RKEY% = 200 THEN GOSUB PROCESSMOUSE
  446.  
  447. LOOP WHILE RKEY% <> 27 AND RKEY% <> 1  ' do until ESC, < CANCEL > or < OK >
  448.  
  449. SETDISK OLDDR%, J%                ' default drive back to original drive
  450. GETOUT:
  451. P$ = PATH$                        ' returned path
  452. F$ = FOUNDFILE$                   ' returned file
  453. CHNGWIND 4: LINEW 19, 0           ' erase < - OK - >, < CANCEL >
  454. FOR X% = 1 TO 3: DELWIND X%: NEXT ' delete scroll windows from window mem.
  455. CALL RSTRINPT(0)                  ' deactivate active input wind (FILE SPEC)
  456. ERASE FIL$, SUBDIR$, DIRINFO
  457. EXIT SUB
  458.  
  459. '---------------------------------------------------------------------------
  460. GETDRVS:
  461.   RKEY% = FINDDRV%             ' drive scroll window
  462. RETURN
  463. '---------------------------------------------------------------------------
  464. GETDIRS:
  465.   RKEY% = FINDSUB%             ' directory scroll window
  466. RETURN
  467. '---------------------------------------------------------------------------
  468. GETFILES:
  469.   RKEY% = FINDFILE%            ' files scroll window
  470. RETURN
  471. '---------------------------------------------------------------------------
  472. ' go to scroll window, choicebar or input window if left mouse button is
  473. ' pressed with mouse cursor in same.
  474.  
  475. PROCESSMOUSE:
  476.   DO WHILE LBUTTON% = 1
  477.    IF MOUSEINWIND%(1) > 0 AND NUMFILES% > 0 THEN LOOKIN% = 2: EXIT DO
  478.    IF MOUSEINWIND%(2) > 0 AND NUMSUBS% > 0 THEN LOOKIN% = 3: EXIT DO
  479.    IF MOUSEINWIND%(3) > 0 THEN LOOKIN% = 4: EXIT DO
  480.    IF MOUSEINWIND%(21) > 0 THEN LOOKIN% = 1: EXIT DO
  481.    IF MOUSEROW% = 22 THEN LOOKIN% = 5: EXIT DO
  482.  LOOP
  483. RETURN
  484. '---------------------------------------------------------------------------
  485. GETSPEC:
  486.   OLDSPEC$ = SPEC$
  487.   CALL B4INPT(EXIT$, "")
  488.   CALL INPTWIND("File Spec: ", "A", 4, 100, 5, 112, 112, SPEC$, RKEY%, 0, 1)
  489.   IF SPEC$ = "" THEN SPEC$ = "*.*"
  490.   IF RKEY% <> 27 AND SPEC$ <> OLDSPEC$ THEN
  491.      ' file spec has changed
  492.      RR% = RKEY%                    ' save exit key
  493.      GOSUB UPDATEALL                ' update all scroll windows
  494.      RKEY% = RR%                    ' restore exit key
  495.      IF WASERR% > 74 THEN SPEC$ = OLDSPEC$: WASERR% = 0
  496.   END IF
  497. RETURN
  498. '---------------------------------------------------------------------------
  499. GETCHOICE:
  500.   REDIM C$(2): C$(1) = "- OK -": C$(2) = "CANCEL"
  501.   RKEY% = CHOICEBAR%(C$(), 22, 15, 50, 112, 1, EXIT$)
  502.   IF RKEY% = 2 THEN RKEY% = 27
  503. RETURN
  504. '---------------------------------------------------------------------------
  505. UPDATEALL:
  506.    EXIT$ = "VIEW"   ' view only for choice bar.  enter and exit to display
  507.    GOSUB GETCHOICE
  508.    CALL MESSAGE(1)
  509.    MODE$ = "VN"     ' view scroll windows ( enter-exit ) no scroll bar on exit
  510.    OLDPATH$ = ""    ' scroll windows update when OLDPATH$ <> PATH$
  511.    GOSUB GETFILES
  512.    IF WASERR% = 0 THEN
  513.      GOSUB GETDIRS
  514.      GOSUB GETDRVS
  515.    END IF
  516.    CALL MESSAGE(0)
  517.  
  518.   ' scroll windows/ choicebar/ input window will be active when entered.
  519.  
  520.    MODE$ = "N"        ' exit scroll windows with scroll bar erased.
  521.    EXIT$ = "OTE"       ' mouse out of/ TAB / SHIFT TAB exit
  522.                       ' CHOICEBAR and INPTWIND.
  523.  
  524.    CALL PRINTFILEINFO
  525.    OLDPATH$ = PATH$   ' no scroll windows update if OLDPATH$ = PATH$
  526.  
  527. RETURN
  528. '---------------------------------------------------------------------------
  529.  
  530. END SUB
  531.  
  532. SUB MESSAGE (M%)
  533.   IF M% = 1 THEN
  534.     CALL MAKEWIND(5, "", 4, 100, 50, 3, 15, 2)
  535.     CALL PRINTW("Please wait.  Reading directory tree .....", 1, 100)
  536.   ELSE
  537.     RSTRWIND 5, 1
  538.   END IF
  539. END SUB
  540.  
  541. SUB PRINTFILEINFO
  542.   ' print the path in the full screen window
  543.  
  544.   CALL CHNGWIND(4)                ' make full screen window active
  545.   P$ = SPACE$(64)
  546.   LSET P$ = PATH$
  547.   CALL PRINTW(P$, 4, 8)           ' print the path in it
  548.   IF OLDPATH$ <> PATH$ THEN       ' if it's a new path
  549.     P$ = SPACE$(12)               ' erase all existing file info
  550.     CALL PRINTW(P$, 5, 8)         ' " "
  551.     CALL PRINTW(P$, 5, 32)        ' " "
  552.     CALL PRINTW(P$, 5, 50)        ' " "
  553.     CALL PRINTW(SPACE$(8), 5, 68) ' " "
  554.   END IF
  555. END SUB
  556.  
  557.