home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / pwez61 / dempart2.bas < prev    next >
Encoding:
BASIC Source File  |  1993-06-01  |  34.2 KB  |  884 lines
  1. '!!! ---------------------------------------------------------------------!!!
  2. '!!!   NOTE: THIS MODULE MUST BE LOADED WITH DEMO.BAS AS THE MAIN MODULE  !!!
  3. '!!! ---------------------------------------------------------------------!!!
  4. '----------  MUST BE IN ANY MODULE USING "FINDDIR" DIRECTORY ROUTINE --------
  5. TYPE DIREC
  6.   SIZE AS LONG              ' SIZE
  7.   DATE AS STRING * 10       ' DATE
  8.   TIME AS STRING * 6        ' TIME
  9.   ATTR AS INTEGER           ' ATTRIBUTE
  10. END TYPE
  11. COMMON SHARED /DIRECTORY/ DIREC$(), DIRINFO() AS DIREC
  12. '----------------------------------------------------------------------------
  13. DECLARE SUB B4INPT (INPTEXIT$, RESTRICT$)
  14. DECLARE SUB B4SCRL (EXIT$, MARK$, TAGCOL%, NOREFRESH%)
  15. DECLARE SUB BOXW (TR%, LC%, WD%, NR%, BORDER%)
  16. DECLARE FUNCTION CHOICEBAR% (Choice$(), TR%, LC%, WD%, ATTR%, HATTR%, EXIT$)
  17. DECLARE FUNCTION CHOICEWIND% (TITLE$, TX$(), CH$(), TR%, LC%, ATTR%, HCOL%, ESCEXIT%, BORDER%)
  18. DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
  19. DECLARE SUB CHNGWIND (W%)
  20. DECLARE SUB CLRWIND ()
  21. DECLARE SUB CUROFF ()
  22. DECLARE SUB DELWIND (W%)
  23. DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
  24. DECLARE SUB DOSOUND ()
  25. DECLARE FUNCTION FINDPATH$ ()
  26. DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
  27. DECLARE SUB GETANS (TEXT$, Choice$, ANS$, TR%, LC%, WATTR%, FATTR%, BORDER%)
  28. DECLARE FUNCTION GETCUR& ()
  29. DECLARE FUNCTION GETDISK% ()
  30. DECLARE SUB INFOFIXED (FIXED$)
  31. DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
  32. DECLARE SUB INPTINIT (DTYPE%, ISDOT%, STARTAT1%, NOBLANK%, SND%)
  33. DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, WATTR%, FATTR%, RTRN$, RK%, BUT%, BRD%)
  34. DECLARE FUNCTION GETAKEY% ()
  35. DECLARE FUNCTION LBUTTON% ()
  36. DECLARE SUB LINEW (ROW%, TYP%)
  37. DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
  38. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  39. DECLARE FUNCTION MARKED% (RTRN$, START%)
  40. DECLARE FUNCTION MOUSECOL% ()
  41. DECLARE SUB MOUSEINIT ()
  42. DECLARE FUNCTION MOUSEINMULT% (MULTSCRN%)
  43. DECLARE FUNCTION MOUSEINWIND% (WIND%)
  44. DECLARE SUB MOUSELIMITS (TROW%, BROW%, LCOL%, RCOL%)
  45. DECLARE FUNCTION MOUSEON% (ONFLAF%)
  46. DECLARE SUB MOUSEPOS (ROW%, COL%)
  47. DECLARE FUNCTION MOUSEROW% ()
  48. DECLARE SUB MOUSESHOW ()
  49. DECLARE SUB MULTINPT (SCRN%, TOFLD%, OPT$, FROMFLD%, RKEY%, RTRN$(), SELFLD%)
  50. DECLARE FUNCTION WVAL& (S$)
  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 SCROLLPRINT (TR%, LC%, ATTR%)
  66. DECLARE SUB SETCUR (C&)
  67. DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
  68. DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
  69. DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
  70. DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%, NOHIGH%, BRACKETATTR%)
  71. DECLARE SUB UPDATEFIELD (SCRN%, FLD%, TEXT$)
  72. DECLARE FUNCTION WAVAIL% (W%)
  73. DECLARE SUB WINDSTATUS ()
  74. '---------------------------------------------------------------------------
  75. DECLARE FUNCTION COL% (A%)
  76. DECLARE SUB PRINTFILEINFO ()
  77. DECLARE FUNCTION FINDDRV% ()
  78. DECLARE FUNCTION FINDSUB% ()
  79. DECLARE FUNCTION FINDFILE% ()
  80. DECLARE SUB MESSAGE (M%)
  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%), VOLUMN$, FILENUM%
  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.   RTRN% = 0
  155.   CHNGWIND 3                                    ' this scroll window active
  156.   CALL B4SCRL("EOMCRT", "", 0, 0)               ' set exit keys
  157.   RKEY% = -1
  158.   CALL SCRLWIND(DRV$(), I$(), "", DRIVES%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  159.  
  160.   IF RKEY% = 13 THEN
  161.      ' ENTER or double MOUSE click
  162.  
  163.     ' make selected drivv active
  164.     CALL SETDISK(ASC(MID$(DRV$(RTRN%), 3, 1)) - 64, B%)
  165.  
  166.     ON ERROR GOTO DERROR                                 ' for FINDPATH$
  167.     CALL MESSAGE(1)                                      ' reading message
  168.     PATH$ = FINDPATH$                                    ' get drive path
  169.     ON ERROR GOTO 0
  170.     IF DISKERROR% = 1 THEN                               ' disk error
  171.        DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION     ' abort selected
  172.     END IF
  173.     IF PATH$ <> OLDPATH$ THEN
  174.       ' new drive was selected so there is different path
  175.  
  176.       ON ERROR GOTO DERROR                               ' about to read disk
  177.       DISKSIZE ASC(PATH$) - 64, DISKSZE&, FREESPACE&     ' get disk info
  178.       ON ERROR GOTO 0
  179.       IF DISKERROR% = 1 THEN                             ' disk error
  180.          DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION   ' abort selected
  181.       END IF
  182.       CHNGWIND 4                                         ' full screen window
  183.       P$ = SPACE$(15): P1$ = P$
  184.       LSET P$ = STR$(DISKSZE&)
  185.       LSET P1$ = STR$(FREESPACE&)
  186.       CALL PRINTW(P$, 17, 21)                            ' print disk bytes
  187.       CALL PRINTW(P1$, 17, 61)                           ' print free bytes
  188.       MODE$ = "NV"                     ' view - exit with scroll bar ereasd
  189.       J% = FINDFILE%                   ' find the files
  190.       J% = FINDSUB%                    ' find the sub directories
  191.       MODE$ = "N"                      ' mode back to not view only
  192.       CALL PRINTFILEINFO               ' erases any displayed file info
  193.       OLDPATH$ = PATH$                 ' to check for future path changes
  194.     END IF
  195.     CALL MESSAGE(0)                    ' erase "reading" message
  196.   END IF
  197. LOOP WHILE RKEY% = 13
  198.  
  199. FINDDRV% = RKEY%                       ' "exit" key in FINDDRV%
  200.  
  201. END FUNCTION
  202.  
  203. FUNCTION FINDFILE% STATIC
  204.  
  205.   RKEY% = 0                                ' no exit key
  206.   CHNGWIND 1                             ' make this the active window
  207.   IF OLDPATH$ <> PATH$ THEN
  208.      ' only if the path has changed
  209.  
  210.      FOUNDFILE$ = ""                     ' new path no selected file
  211.      ON ERROR GOTO DERROR
  212.      CALL FINDDIR(LEFT$(PATH$, 3) + "*.*", "LV", F%)
  213.      IF F% <> 0 THEN VOLUMN$ = DIREC$(F%)
  214.      CALL FINDDIR(PATH$ + SPEC$, "AHSROL", NFIL%)   ' find all files
  215.      ON ERROR GOTO 0
  216.      IF DISKERROR% = 1 THEN              ' was a disk error
  217.        PATH$ = LASTGOODPATH$             ' restore last good path
  218.        DISKERROR% = 0: FINDFILE% = 100: EXIT FUNCTION   ' abort selected
  219.      END IF
  220.      FIL% = NFIL%                     ' FIL% = number of found files
  221.      NUMFILES% = FIL%                 ' NUMFILES% shared with GETFILE
  222.      NR% = 0                          ' tells B4SCRL refresh the scroll wind
  223.      RTRN% = 1                        ' start on first file
  224.      LI% = 1                          ' on line 1
  225.      CLRWIND                          ' clear the scroll window
  226.      REDIM FIL$(FIL%)                 ' make scroll window entries.
  227.      X% = 1
  228.      FOR X% = 1 TO FIL%
  229.       SWAP FIL$(X%), DIREC$(X%)       ' "       "
  230.      NEXT
  231.      ERASE DIREC$                     ' get the memory back
  232.   ELSE                                ' no new path.
  233.      NR% = 1                          ' tell B4SCRL no need to refresh wind
  234.   END IF
  235.      
  236.   IF MODE$ = "N" THEN MODE$ = "SN"
  237.      
  238.   IF FIL% <> 0 THEN
  239.     ' only if there are files
  240.     ' set exit keys - determine if scroll window is refreshed. enter scroll wind
  241.      CALL B4SCRL("OEMCRT", "", 0, NR%)
  242.      SCROLLPRINT 8, 9, 112
  243.      RKEY% = -1
  244.  
  245.      CALL SCRLWIND(FIL$(), I$(), "", FIL%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  246.      IF MODE$ = "SN" THEN
  247.        FILENUM% = RTRN%
  248.        FOUNDFILE$ = FIL$(RTRN%)
  249.      END IF
  250.      IF RKEY% = 13 THEN
  251.        ' ENTER selected or double MOUSE click
  252.        CALL PRINTFILEINFO                      ' erase last selected file info
  253.        FOUNDFILE$ = FIL$(RTRN%)                ' new selected file
  254.        P$ = SPACE$(12)
  255.        LSET P$ = FOUNDFILE$
  256.        PRINTW FOUNDFILE$, 5, 8
  257.        P1$ = SPACE$(8)
  258.        LSET P1$ = STR$(DIRINFO(RTRN%).SIZE)
  259.        CALL PRINTW("Bytes:" + P1$, 5, 25)                ' print file size
  260.        CALL PRINTW("Date:" + DIRINFO(RTRN%).DATE, 5, 45) ' print file date
  261.        CALL PRINTW("Time:" + DIRINFO(RTRN%).TIME, 5, 64) ' print file time
  262.      END IF
  263.     END IF
  264.    FINDFILE% = RKEY%                               ' "exit" key in FINDFILE%
  265.    IF MODE$ = "SN" THEN MODE$ = "N"
  266.  
  267. END FUNCTION
  268.  
  269. FUNCTION FINDSUB% STATIC
  270.  
  271. RKEY% = 0                                      ' no exit key
  272. GOSUB GETSUBS                                  ' get any sub directories
  273.  
  274. DO
  275.   CHNGWIND 2                                   ' make this window active
  276.   IF NR% = 0 THEN CLRWIND                      ' clear it if to be refreshed
  277.   IF SUBDIR% <> 0 THEN
  278.      ' sub GETSUBS found some subs
  279.  
  280.      ' set exit keys and determine if window is to be refreshed - enter wind
  281.      RKEY% = -1
  282.      CALL B4SCRL("OEMCRT", "", 0, NR%)
  283.      CALL SCRLWIND(SUBDIR$(), I$(), "", SUBDIR%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
  284.  
  285.      IF RKEY% = 13 THEN
  286.         ' ENTER selected or double MOUSE click
  287.  
  288.         IF SUBDIR$(RTRN%) = ".." THEN
  289.           ' go "up" the dir tree
  290.  
  291.           DO
  292.             PATH$ = LEFT$(PATH$, LEN(PATH$) - 1)
  293.             IF RIGHT$(PATH$, 1) = "\" THEN
  294.               PATH$ = LEFT$(PATH$, LEN(PATH$))
  295.               EXIT DO
  296.             END IF
  297.           LOOP
  298.         ELSE
  299.           'add selected dir to existing to existing path
  300.           PATH$ = PATH$ + SUBDIR$(RTRN%) + "\"
  301.           END IF
  302.           CALL MESSAGE(1)           ' "reading" message
  303.           GOSUB GETSUBS             ' find subs based on selection
  304.           MODE$ = "NV"              ' call to FINDFILE% is view only
  305.           J% = FINDFILE%            ' get the files for the new path
  306.           CALL MESSAGE(0)           ' erase the message
  307.           MODE$ = "N"               ' mode no longer view only
  308.           CALL PRINTFILEINFO        ' erase any exiting file infp
  309.           OLDPATH$ = PATH$
  310.         END IF
  311.   END IF
  312. LOOP WHILE RKEY% = 13
  313.  
  314. FINDSUB% = RKEY%                  ' return with "exit" key in FINDSUB%
  315.  
  316. EXIT FUNCTION
  317.  
  318. '---------------------------------------------------------------------------
  319. ' get any sub directories
  320.  
  321. GETSUBS:
  322.  IF PATH$ <> OLDPATH$ THEN
  323.    ' only if the path has changed
  324.    ON ERROR GOTO DERROR
  325.    CALL FINDDIR(PATH$ + "*.*", "D", F%)   ' find all dirs
  326.    ON ERROR GOTO 0
  327.    IF DISKERROR% = 1 THEN                ' was a disk error
  328.       DISKERROR% = 0: FINDSUB% = 100     ' abort was selected
  329.       PATH$ = OLDPATH$                   ' error, so restore the old path
  330.       EXIT FUNCTION                      ' and get ot
  331.    END IF
  332.    LASTGOODPATH$ = PATH$                 ' save the path
  333.    IF F% > 0 THEN
  334.      ' dirs were found
  335.  
  336.      IF DIREC$(1) = "." THEN
  337.         SUBDIR% = F% - 1: START% = 2     ' not using the root dir
  338.      ELSE
  339.         SUBDIR% = F%: START% = 1         ' path was changed to root dir
  340.      END IF
  341.      REDIM SUBDIR$(SUBDIR%)              ' to hold sub-directories
  342.      Y% = 1
  343.      FOR X% = START% TO F%
  344.         SWAP SUBDIR$(Y%), DIREC$(X%)     ' put sub dirs in SUBDIR%()
  345.         Y% = Y% + 1
  346.      NEXT
  347.      ERASE DIREC$                        ' get the memory back
  348.    ELSE
  349.      SUBDIR% = 0                         ' no sub dirs found
  350.    END IF
  351.    NUMSUBS% = SUBDIR%                    ' for GETFILE%
  352.    NR% = 0                               ' tell B4SCRL to refresh wind
  353.    RTRN% = 1                             ' start on first entry
  354.  ELSE
  355.    NR% = 1                               ' no new path - don't refresh wind
  356.  END IF
  357. RETURN
  358.  
  359. END FUNCTION
  360.  
  361. SUB GETANSDEMO
  362.  
  363.   A% = COL%(95)        ' COLOR GRAY/PURPLE OR B/W
  364.  
  365.   ' MAKE WINDOW 1 AND PRINT IN SAME.
  366.  
  367.   MAKEWIND 1, "@***** Get Answer Window Demonstration *****", 4, 100, 72, 9, A%, 132
  368.   PRINTW "Get answer  windows are used to ask a question and wait for a single", 1, 100
  369.   PRINTW "key response.  They can also be used to pause a program and wait for", 2, 100
  370.   PRINTW "any key to be pressed.  Prompts may be windowed or un-windowed.  The", 3, 100
  371.   PRINTW "area under the prompt or window is restored on exit. If the response", 4, 100
  372.   PRINTW "is displayed, ENTER must be pressed to accept it....", 5, 2
  373.   PRINTINFO " Press Y or N.  Press ENTER to accept...."
  374.  
  375.   ' Y, N or ESC are valid responses.. Displays "N" on entry as ANS$ = "N"
  376.  
  377.   ANS$ = "N"
  378.   GETANS "Are you sure? (Y/N) " + S$, "YN", ANS$, 13, 100, A%, 15, 32
  379.   IF ANS$ <> CHR$(27) THEN
  380.     IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO"
  381.     GOSUB REPLY
  382.  
  383.     PRINTINFO " Press A, B or C..."
  384.     ' A, B, C or ESC are valid.  No fiels displayed on entry as ABS$ = ""
  385.     ANS$ = ""
  386.     GETANS "Press A, B or C to continue" + S$, "ABC", ANS$, 13, 100, A%, 0, 32
  387.   END IF
  388.   IF ANS$ <> CHR$(27) THEN
  389.     TEMP$ = ANS$: GOSUB REPLY
  390.   END IF
  391.   RSTRWIND 1, 1
  392.   EXIT SUB
  393.  
  394. REPLY:
  395.   PRINTINFO " Press any key....."
  396.   GETANS "Your reply was: " + TEMP$ + ".   Press any key...", "", "", 13, 100, A% + 128, 0, 32
  397. RETURN
  398.  
  399. END SUB
  400.  
  401. SUB GETFILE (P$, F$, RKEY%) STATIC
  402.  
  403.   WASERR% = 0                            ' start no errors
  404.   A% = COL%(31)                          ' color or b/w
  405.   CALL MAKEWIND(4, "@[ Select a file ]", 1, 1, 80, 25, 112, 102)
  406.   OLDDR% = GETDISK%                      ' save existing default drive
  407.   ON ERROR GOTO DERROR
  408.   PATH$ = FINDPATH$                      ' get existing path
  409.   DISKSIZE OLDDR%, DISKSZE&, FREESPACE&  ' and existing disk size/ free space
  410.   ON ERROR GOTO 0
  411.   IF DISKERROR% = 1 THEN                 ' was a disk error
  412.     DISKERROR% = 0                       ' abort was selected
  413.     GOTO GETOUT
  414.   END IF
  415.   CALL PRINTW("DISK BYTES:" + STR$(DISKSZE&), 17, 10)   ' print disk bytes
  416.   CALL PRINTW("FREE BYTES:" + STR$(FREESPACE&), 17, 50) ' print free bytes
  417.   CALL PRINTW("ID:", 3, 2)
  418.   CALL PRINTW("Path:", 4, 2)             ' print in full screen window
  419.   CALL PRINTW("File:", 5, 2)             ' "
  420.   CALL LINEW(18, 1)                      ' "
  421.   CALL LINEW(20, 1)                      ' "
  422.   '-------------------------------------------------------------------------
  423.   ' make the three windows to be used as scroll windows
  424.  
  425.   CALL MAKEWIND(1, "@Files", 10, 10, 16, 9, A%, 101)
  426.   CALL MAKEWIND(2, "@Directories", 10, 36, 16, 9, A%, 101)
  427.   CALL MAKEWIND(3, "@Drives", 10, 61, 10, 9, A%, 101)
  428.  
  429.   '-------------------------------------------------------------------------
  430.   ' print/update scroll windows -- print choicebar
  431.  
  432.   SPEC$ = "*.*"              ' start with all files
  433.   GOSUB UPDATEALL            ' update scroll windows and choice bar
  434.   WASERR% = 0
  435.   '-------------------------------------------------------------------------
  436.   LOOKIN% = 1                ' start in FILE SPEC: input window
  437.  
  438.   ' for info-line
  439.   I$ = " Press ENTER or DOUBLE CLICK MOUSE to select.   Press tab to move."
  440.  
  441. DO
  442.   SELECT CASE LOOKIN%
  443.  
  444.     CASE 1               ' file spec input window
  445.       CALL PRINTINFO(" Enter a file spec. ( EX: *.BAS / *.DOC ).  ENTER accepts - TAB moves.")
  446.       GOSUB GETSPEC
  447.       IF RKEY% = 14 OR RKEY% = 15 THEN LOOKIN% = 2  ' TAB or SHIFT+TAB
  448.     CASE 2               ' files scroll window
  449.       INFOFIXED I$
  450.       GOSUB GETFILES
  451.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 3   ' TAB "view" or no entries
  452.       IF RKEY% = 14 THEN LOOKIN% = 1                ' SHIFT/TAB
  453.       IF RKEY% = 13 THEN RKEY% = 1                  ' SAME AS <OK>
  454.  
  455.     CASE 3               ' directory scroll window
  456.       INFOFIXED I$
  457.       GOSUB GETDIRS
  458.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 4   ' TAB "view" or no entries
  459.       IF RKEY% = 14 THEN LOOKIN% = 2                ' SHIFT/TAB
  460.  
  461.     CASE 4               ' drives scroll window
  462.       INFOFIXED I$
  463.       GOSUB GETDRVS
  464.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 5   ' TAB "view" or no entries
  465.       IF RKEY% = 14 THEN LOOKIN% = 3                ' SHIFT/TAB
  466.  
  467.     CASE 5               ' < OK >, < CANCEL > choicebar
  468.       CALL PRINTINFO(" Select OK to accept or CANCEL to cancel.")
  469.       GOSUB GETCHOICE
  470.       IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 1   ' TAB or "view"
  471.       IF RKEY% = 14 THEN LOOKIN% = 4                ' SHIFT/TAB
  472.   END SELECT
  473.  
  474.   INFOFIXED ""           ' erase infoline fixed string
  475.  
  476.   ' rkey% = 200 if left mouse button pressed out of window, field or choicebar.
  477.   IF RKEY% = 200 THEN GOSUB PROCESSMOUSE
  478.  
  479. LOOP WHILE RKEY% <> 27 AND RKEY% <> 1  ' do until ESC, < CANCEL > or < OK >
  480.  
  481. SETDISK OLDDR%, J%                ' default drive back to original drive
  482. GETOUT:
  483. P$ = PATH$                        ' returned path
  484. F$ = FOUNDFILE$                   ' returned file
  485. CHNGWIND 4: LINEW 19, 0           ' erase < - OK - >, < CANCEL >
  486. IF F$ <> "" AND RKEY% = 1 THEN
  487.    PRINTW F$, 5, 8
  488.    P1$ = STR$(DIRINFO(FILENUM%).SIZE)
  489.    CALL PRINTW("Bytes:" + P1$, 5, 25)                ' print file size
  490.    CALL PRINTW("Date:" + DIRINFO(FILENUM%).DATE, 5, 45) ' print file date
  491.    CALL PRINTW("Time:" + DIRINFO(FILENUM%).TIME, 5, 64) ' print file time
  492. END IF
  493.  
  494. FOR X% = 1 TO 3: DELWIND X%: NEXT ' delete scroll windows from window mem.
  495. CALL RSTRINPT(0)                  ' deactivate active input wind (FILE SPEC)
  496. ERASE FIL$, SUBDIR$, DIRINFO
  497. EXIT SUB
  498.  
  499. '---------------------------------------------------------------------------
  500. GETDRVS:
  501.   RKEY% = FINDDRV%             ' drive scroll window
  502. RETURN
  503. '---------------------------------------------------------------------------
  504. GETDIRS:
  505.   RKEY% = FINDSUB%             ' directory scroll window
  506. RETURN
  507. '---------------------------------------------------------------------------
  508. GETFILES:
  509.   RKEY% = FINDFILE%            ' files scroll window
  510. RETURN
  511. '---------------------------------------------------------------------------
  512. ' go to scroll window, choicebar or input window if left mouse button is
  513. ' pressed with mouse cursor in same.
  514.  
  515. PROCESSMOUSE:
  516.   DO WHILE LBUTTON% = 1
  517.    IF MOUSEINWIND%(1) > 0 AND NUMFILES% > 0 THEN LOOKIN% = 2: EXIT DO
  518.    IF MOUSEINWIND%(2) > 0 AND NUMSUBS% > 0 THEN LOOKIN% = 3: EXIT DO
  519.    IF MOUSEINWIND%(3) > 0 THEN LOOKIN% = 4: EXIT DO
  520.    IF MOUSEINWIND%(21) > 0 THEN LOOKIN% = 1: EXIT DO
  521.    IF MOUSEROW% = 22 THEN LOOKIN% = 5: EXIT DO
  522.  LOOP
  523. RETURN
  524. '---------------------------------------------------------------------------
  525. GETSPEC:
  526.   OLDSPEC$ = SPEC$
  527.   CALL B4INPT(EXIT$, "")
  528.   CALL INPTWIND("File Spec: ", "A", 4, 100, 5, 112, 112, SPEC$, RKEY%, 0, 1)
  529.   IF SPEC$ = "" THEN SPEC$ = "*.*"
  530.   IF RKEY% <> 27 AND SPEC$ <> OLDSPEC$ THEN
  531.      ' file spec has changed
  532.      RR% = RKEY%                    ' save exit key
  533.      GOSUB UPDATEALL                ' update all scroll windows
  534.      RKEY% = RR%                    ' restore exit key
  535.      IF WASERR% > 74 THEN SPEC$ = OLDSPEC$: WASERR% = 0
  536.   END IF
  537. RETURN
  538. '---------------------------------------------------------------------------
  539. GETCHOICE:
  540.   REDIM C$(2): C$(1) = "- OK -": C$(2) = "CANCEL"
  541.   RKEY% = CHOICEBAR%(C$(), 22, 15, 50, 112, 1, EXIT$)
  542.   IF RKEY% = 2 THEN RKEY% = 27
  543. RETURN
  544. '---------------------------------------------------------------------------
  545. UPDATEALL:
  546.    EXIT$ = "VIEW"   ' view only for choice bar.  enter and exit to display
  547.    GOSUB GETCHOICE
  548.    CALL MESSAGE(1)
  549.    MODE$ = "VN"     ' view scroll windows ( enter-exit ) no scroll bar on exit
  550.    OLDPATH$ = ""    ' scroll windows update when OLDPATH$ <> PATH$
  551.    GOSUB GETFILES
  552.    IF WASERR% = 0 THEN
  553.      GOSUB GETDIRS
  554.      GOSUB GETDRVS
  555.    END IF
  556.    CALL MESSAGE(0)
  557.  
  558.   ' scroll windows/ choicebar/ input window will be active when entered.
  559.  
  560.    MODE$ = "N"        ' exit scroll windows with scroll bar erased.
  561.    EXIT$ = "OTE"       ' mouse out of/ TAB / SHIFT TAB exit
  562.                       ' CHOICEBAR and INPTWIND.
  563.  
  564.    CALL PRINTFILEINFO
  565.    OLDPATH$ = PATH$   ' no scroll windows update if OLDPATH$ = PATH$
  566.  
  567. RETURN
  568. '---------------------------------------------------------------------------
  569.  
  570. END SUB
  571.  
  572. SUB MESSAGE (M%)
  573.   IF M% = 1 THEN
  574.     CALL MAKEWIND(5, "", 4, 100, 38, 3, 15, 2)
  575.     CALL PRINTW("Reading directory tree....", 1, 100)
  576.   ELSE
  577.     RSTRWIND 5, 1
  578.   END IF
  579. END SUB
  580.  
  581. SUB MULTINPUTDEMO2
  582.      RSTRINFO 0                               ' RESTORE AREA UNDER INFOLINE
  583.      INFOLINE 0, 0, 0, 15
  584.      C& = GETCUR&
  585.  
  586.      A% = COL%(23): IF A% = 15 THEN A% = 112  ' A%= COLOR -- B/W
  587.      STATIC CHNGRTRN$(), ONSEARCH%, NOTFIRSTPASS%, HOTCOL%
  588.      IF NOTFIRSTPASS% = 0 THEN
  589.         REDIM CHNGRTRN$(11)                       ' FOR "CHANGE" MULTINPT
  590.         CHNGRTRN$(3) = "[ ] Match Upper/Lowercase"
  591.         CHNGRTRN$(4) = "[ ] Whole Word"
  592.         CHNGRTRN$(5) = "(" + CHR$(4) + ") 1. Active Window"
  593.         CHNGRTRN$(6) = "( ) 2. Current Module"
  594.         CHNGRTRN$(7) = "( ) 3. All Modules"
  595.         CHNGRTRN$(8) = "< Find and Verify >"
  596.         CHNGRTRN$(9) = "< Change All >"
  597.         CHNGRTRN$(10) = "< Cancel >"
  598.         CHNGRTRN$(11) = "< Help >"
  599.         ONSEARCH% = 5
  600.         NOTFIRSTPASS% = 1
  601.      END IF
  602.  
  603.      ' PRINT THE INPUT SCREEN IN WINDOW 15
  604.  
  605.      MAKEWIND 15, "@Multi-field Input.  Extensive use of fixed choice fields.", 1, 1, 80, 25, A%, 102
  606.      MAKEWIND 0, "@ Change ", 6, 100, 59, 15, 112, 11
  607.      LINEW 12, 1
  608.  
  609.      IF DEMONOHI% = 1 THEN HOTCOL% = 7 ELSE HOTCOL% = 127
  610.  
  611.      CALL BOXW(1, 14, 43, 3, 1)
  612.      PRINTWHOT "Find What:", 2, 2, 1, HOTCOL%
  613.  
  614.      CALL BOXW(4, 14, 43, 3, 1)
  615.      PRINTWHOT "Change To:", 5, 2, 8, HOTCOL%
  616.  
  617.      CALL BOXW(7, 32, 25, 5, 1)
  618.      PRINTW " Search ", 7, 40
  619.      TOFLD% = 1                   ' START IN FIELD ONE.
  620.      FROMFLD% = 0                 ' UPDATE ALL FIELDS.
  621.  
  622. CHANGE:
  623.      ' CURSOR TO FIELD 5 TO 7.  THIS IS THE "SEARCH" SCOPE
  624.  
  625.      IF TOFLD% > 4 AND TOFLD% < 8 THEN
  626.          TOFLD% = ONSEARCH%
  627.      END IF
  628.  
  629.      SELECT CASE TOFLD%                         ' PU INSTRUCTIONS IN A$
  630.        CASE 1, 2                                ' ON ACTIVE (TOFLD%) FIELD.
  631.          A$ = "Input data."
  632.        CASE 3, 4
  633.          A$ = "Press SPACE BAR to change."
  634.        CASE 5, 6, 7
  635.          A$ = "Press UP/DOWN arrow keys to change."
  636.        CASE 8 TO 11
  637.          A$ = "Press SPACE BAR/ENTER to select."
  638.        CASE ELSE
  639.          A$ = ""
  640.      END SELECT
  641.      A$ = A$ + " TAB = next field. ESC/ENTER exits."
  642.  
  643.      PRINTINFO " " + A$
  644.  
  645.      ' GET MULTIFIELD INPUT.  TOFLD% = THE ACTIVE FIELD ON ENTRY.  FROMFLD%
  646.      ' REPRESENTS THE FIELD WHICH IS ACTIVE ON EXIT
  647.  
  648.      MULTINPT 3, TOFLD%, "U", FROMFLD%, RK%, CHNGRTRN$(), 0
  649.  
  650.      IF RK% = 50 THEN RK% = 100                  ' key character selection
  651.      IF RK% = 300 THEN GOTO CHANGE               ' mouse release out of field
  652.      IF RK% = 100 THEN FROMFLD% = TOFLD%
  653.  
  654.      IF FROMFLD% > 4 AND FROMFLD% < 8 THEN        ' Cursor from search window.
  655.        IF RK% = 16 OR RK% = 19 OR RK% = 100 THEN  ' Was UP or DOWN arrow.
  656.          IF RK% < 100 THEN
  657.            IF TOFLD% = 4 THEN TOFLD% = 7          ' Keep cursor in the
  658.            IF TOFLD% = 8 THEN TOFLD% = 5          ' search window.
  659.          END IF
  660.          MID$(CHNGRTRN$(ONSEARCH%), 2, 1) = " "   ' make it a blank
  661.          FROMFLD% = ONSEARCH%                     ' blank this field
  662.          ONSEARCH% = TOFLD%
  663.          MID$(CHNGRTRN$(TOFLD%), 2, 1) = CHR$(4)  ' Only one choice is permitted.
  664.         END IF
  665.         IF RK% = 14 THEN TOFLD% = 4               ' Was SHIFT TAB
  666.         IF RK% = 15 THEN TOFLD% = 8               ' Was TAB
  667.      END IF
  668.  
  669.      SELECT CASE RK%
  670.    
  671.         ' RETURN CAUSED EXIT.
  672.  
  673.         CASE 13
  674.           PICK$ = "ENTER"
  675.           IF FROMFLD% >= 7 THEN PICK$ = CHNGRTRN$(FROMFLD%)
  676.           GOTO PRINTRESULTS
  677.  
  678.         ' ESC CAUSED EXIT.
  679.         CASE 27
  680.           PICK$ = "ESC"
  681.           GOTO PRINTRESULTS
  682.  
  683.         ' SPACE BAR CAUSED EXIT.
  684.         CASE 32, 100
  685.           IF FROMFLD% = 3 OR FROMFLD% = 4 THEN     ' EXITING FIELD 3 OR 4
  686.              IF MID$(CHNGRTRN$(FROMFLD%), 2, 1) = " " THEN
  687.                 X$ = "X"
  688.              ELSE
  689.                 X$ = " "
  690.              END IF
  691.              MID$(CHNGRTRN$(FROMFLD%), 2, 1) = X$
  692.  
  693.              'IF CHNGRTRN$(FROMFLD%) = "" THEN CHNGRTRN$(FROMFLD%) = "X" ELSE CHNGRTRN$(FROMFLD%) = ""
  694.           ELSEIF FROMFLD% > 7 THEN              ' EXITING FIELD 8,9,10,11
  695.              PICK$ = CHNGRTRN$(FROMFLD%)
  696.              GOTO PRINTRESULTS
  697.           ELSE                                  ' FIELD 5,6,7
  698.           'NOTHING
  699.           END IF
  700.          
  701.         CASE ELSE
  702.      END SELECT
  703.  
  704.      GOTO CHANGE
  705.  
  706. PRINTRESULTS:
  707.  
  708.      ' PRINT THE RESULTS IN WINDOW 1.  GETANS WAITS FOR ANY KEY.
  709.      REDIM T$(9)
  710.      T$(1) = SPACE$(55)
  711.      T$(2) = " Find What: = " + CHNGRTRN$(1)
  712.      T$(3) = " Change To:  = " + CHNGRTRN$(2)
  713.      IF MID$(CHNGRTRN$(3), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
  714.      T$(4) = " Match Upper/Lowercase = " + S$
  715.      IF MID$(CHNGRTRN$(4), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
  716.      T$(5) = " Whole Word = " + S$
  717.      SELECT CASE ONSEARCH%
  718.        CASE 5
  719.         S$ = "Active Window"
  720.        CASE 6
  721.         S$ = "Current Module"
  722.        CASE ELSE
  723.         S$ = "All Modules"
  724.      END SELECT
  725.      T$(7) = " Search Criteria = " + S$
  726.      T$(9) = " Exit was via ...." + PICK$
  727.      REDIM Choice$(1)
  728.      Choice$(1) = "OK"
  729.      PRINTINFO " Select OK to proceed..........."
  730.  
  731.    
  732.      A% = CHOICEWIND%("@Results", T$(), Choice$(), 6, 11, 112, 112, 1, 111)
  733.  
  734.      SETCUR (C&)
  735.  
  736.      ' RESTORING WINDOW 15 RESTORES THE SCREEN TO IT'S
  737.      ' STATE BEFORE THIS SUB WAS CALLED.
  738.  
  739.      RSTRWIND 15, 1
  740.      INFOLINE 0, 0, 0, COL%(31)
  741.  
  742. END SUB
  743.  
  744. SUB MULTSETUP (SCRN%)
  745.   A% = 25
  746.   REDIM M(A%) AS STRING * 50
  747.  
  748.   'DECLARE SUB MAKEFIELD " (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
  749.   SELECT CASE SCRN%
  750.     CASE 1        'CD    T L W  B  A  M   H C BR RES EXTO
  751.       CALL SETINPT(1, 25, "01", 0)
  752.        LSET M(1) = "10000,6,5,10,15,15,15,0,0,0, , ,"
  753.        LSET M(2) = "10040,8,5,10,15,15,15,0,0,0, , ,"
  754.        LSET M(3) = "10001,6,20,10,15,15,15,0,0,0, , ,"
  755.        LSET M(4) = "10002,6,35,10,15,15,15,0,0,0, , ,"
  756.  
  757.  
  758.        LSET M(5) = "30007,6,58,12,15,15,15,0,0,0, , ,"
  759.        LSET M(6) = "30007,8,58,12,15,15,15,0,0,0, , ,"
  760.  
  761.        LSET M(7) = "10017,11,5,20,15,15,15,0,0,0, , ,"
  762.        LSET M(8) = "10027,11,31,20,15,15,15,0,0,0, , ,"
  763.        LSET M(9) = "10007,11,55,20,15,15,15,0,0,0, , ,"
  764.  
  765.        LSET M(10) = "11017,16,22,1,15,15,15,0,0,0,MF, ,"
  766.        LSET M(11) = "11017,16,38,1,15,15,15,0,0,0,YN, ,"
  767.  
  768.  
  769.        LSET M(12) = "11000,16,60,3,15,15,15,0,0,0, , ,"
  770.        LSET M(13) = "11000,16,64,2,15,15,15,0,0,0, , ,"
  771.        LSET M(14) = "11000,16,67,3,15,15,15,0,0,0, , ,"
  772.  
  773.        LSET M(15) = "11000,21,23,6,15,15,15,0,0,0, , ,"
  774.        LSET M(16) = "11000,21,38,6,15,15,15,0,0,0, , ,"
  775.        LSET M(17) = "100,21,53,7,15,15,15,0,0,0, , ,"
  776.  
  777.        LSET M(18) = "30107,24,15,11,112,112,15,0,0,0, , ,"
  778.        LSET M(19) = "30107,24,55,12,112,112,15,0,0,0, , ,"
  779.     CASE 2
  780.  
  781.       CALL SETINPT(2, 25, "EO", 127)
  782.    
  783.        LSET M(1) = "30000,6,4,3,112,112,112,0,2,1, , ,"     ' Click
  784.        LSET M(2) = "30000,7,4,3,112,112,112,0,2,1, , ,"     ' Beep
  785.        LSET M(3) = "30000,8,4,3,112,112,112,0,2,1, , ,"     ' No sound
  786.        LSET M(4) = "30000,12,4,5,112,112,112,0,2,1, , ,"    ' Slow print
  787.        LSET M(5) = "30000,6,28,3,112,112,112,0,2,1, , ,"    ' Start of text
  788.        LSET M(6) = "30000,7, 28,3,112,112,112,0,2,1, , ,"   ' End of text
  789.        LSET M(7) = "30000,11,28,3,112,112,112,0,2,1, , ,"   ' Erase and print
  790.        LSET M(8) = "30000,12,28,3,112,112,112,0,2,1, , ,"   ' Prints
  791.        LSET M(9) = "30000,16,28,3,112,112,112,0,2,1, , ,"   ' Make default snd
  792.        LSET M(10) = "30000,17,28,3,112,112,112,0,2,1, , ,"  ' No sound"
  793.        LSET M(11) = "30000,21,28,3,112,112,112,0,2,1, , ,"  ' As a period
  794.        LSET M(12) = "30000,22,28,3,112,112,112,0,2,1, , ,"  ' As a comma
  795.        LSET M(13) = "10007,7,65,10,15,15,15,0,0,1, , ,"     ' Text
  796.        LSET M(14) = "10030,10,65,10,15,15,15,0,0,1, , ,"    ' Number
  797.        LSET M(15) = "10008,13,65,10,15,15,15,0,0,1, , ,"    ' Date
  798.        LSET M(16) = "30007,15,65,9,112,112,15,0,3,1, , ,"   ' < SOUND >
  799.        LSET M(17) = "30007,18,65,10,112,7,7,0,5,1, , ,"     ' < Ok >
  800.        LSET M(18) = "30007,21,65,10,112,7,7,0,3,1, , ,"     ' < Cancel >
  801.  
  802.     CASE 3
  803.  
  804.       CALL SETINPT(3, 25, "E", 127)
  805.  
  806.  
  807.        LSET M(1) = "10007,8,26,41,112,112,112,0,0,0, ,F,"   'Find What:
  808.        LSET M(2) = "10007,11,26,41,112,112,112,0,0,0, ,T,"  'Change To:
  809.  
  810.        LSET M(3) = "30007,14,13,25,112,112,112,5,2,0, ,M,"  'Match Upper/Lowercase
  811.        LSET M(4) = "30007,15,13,25,112,112,112,5,2,0, ,W,"  'Whole Word
  812.  
  813.        LSET M(5) = "30007,14,45,21,112,112,112,5,2,0, ,1,"  'Active Window
  814.        LSET M(6) = "30007,15,45,21,112,112,112,5,2,0, ,2,"   'Current Module
  815.        LSET M(7) = "30007,16,45,21,112,112,112,5,2,0, ,3,"  'All Modules
  816.  
  817.        LSET M(8) = "30007,19,13,19,112,112,7,12,3,1, ,V,"   'Find and Verify
  818.        LSET M(9) = "30007,19,33,14,112,112,7,3,3,1, ,C,"    'Change All
  819.        LSET M(10) = "30007,19,48,10,112,112,7,0,3,1, , ,"   'Cancel
  820.        LSET M(11) = "30007,19,59,8,112,112,7,3,3,1, ,H,"    'Help
  821.  
  822.     CASE 4
  823.       CALL SETINPT(4, 25, "10", 0)
  824.  
  825.  
  826.        LSET M(1) = "10007,5,14,32,15,15,15,0,0,0, , ,"   ' name - upper case
  827.        LSET M(2) = "10007,7,14,32,15,15,15,0,0,0, , ,"   ' address - upper case
  828.        LSET M(3) = "10007,9,14,32,15,15,15,0,0,0, , ,"   ' address - upper case
  829.        LSET M(4) = "10007,11,14,32,15,15,15,0,0,0, , ,"  ' city/state - upper case
  830.        LSET M(5) = "10010,13,14,5,15,15,15,0,0,0, , ,"   ' zip - padded w/0's
  831.        LSET M(6) = "10008,5,56,10,15,15,15,0,0,0, , ,"   ' date
  832.        LSET M(7) = "10017,7,69,1,15,15,15,0,0,0,YN, ,"   ' registered user ( Y or N )
  833.        LSET M(8) = "10000,9,69,5,15,15,15,0,0,0, , ,"    ' registration number
  834.        LSET M(9) = "10017,13,69,1,15,15,15,0,0,0,YN, ,"  ' USE or CANADA ( Y or N )
  835.        LSET M(10) = "30007,15,25,20,15,15,15,0,0,0, , ," ' programming language
  836.        LSET M(11) = "30007,15,58,20,15,15,15,0,0,0, , ," ' disk size
  837.        LSET M(12) = "11017,17,33,1,15,15,15,0,0,0,YN, ," ' hard copy docs ( Y or N )
  838.        LSET M(13) = "10007,22,24,20,15,15,15,0,0,0,123456789 0, ," ' Visa/MC card number
  839.        LSET M(14) = "10007,22,63,5,15,15,15,0,0,0,1234567890/, ," ' expiration date
  840.  
  841.        LSET M(15) = "30107,2,7,11,112,112,15,0,0,0, , ,"  ' F1=ABORT (mouse selectable)
  842.        LSET M(16) = "30107,2,62,13,112,112,15,0,0,0, , ," ' F10=PRINT (mouse selectable)
  843.  
  844.   END SELECT
  845.   F% = 1
  846.   DO WHILE M(F%) <> STRING$(50, 0)
  847.      A% = 10: REDIM C%(A%)
  848.      E% = 0
  849.      FOR X% = 1 TO 12
  850.        S% = E% + 1
  851.        E% = INSTR(S%, M(F%), ",")
  852.        X$ = MID$(M(F%), S%, E% - S%)
  853.        SELECT CASE X%
  854.          CASE 1 TO 10
  855.            C%(X%) = WVAL&(X$)
  856.          CASE 11
  857.            RES$ = LTRIM$(X$)
  858.          CASE 12
  859.            EXTO$ = LTRIM$(X$)
  860.        END SELECT
  861.      NEXT
  862.      CALL MAKEFIELD(SCRN%, F%, C%(1), C%(2), C%(3), C%(4), C%(5), C%(6), C%(7), RES$, EXTO$, C%(8), C%(9), C%(10))
  863.      F% = F% + 1
  864.   LOOP
  865.  
  866. END SUB
  867.  
  868. SUB PRINTFILEINFO
  869.   ' print the path in the full screen window
  870.  
  871.   CALL CHNGWIND(4)                ' make full screen window active
  872.   P$ = SPACE$(64)
  873.   V$ = SPACE$(12)
  874.   LSET V$ = VOLUMN$
  875.   LSET P$ = PATH$
  876.   CALL PRINTW(P$, 4, 8)           ' print the path in it
  877.   CALL PRINTW(V$, 3, 6)           ' print the VOLUMN
  878.   IF OLDPATH$ <> PATH$ THEN       ' if it's a new path
  879.     P$ = SPACE$(12)               ' erase all existing file info
  880.     CALL PRINTW(P$, 5, 8)         ' " "
  881.   END IF
  882. END SUB
  883.  
  884.