home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Tu-Basic / MC6.INC < prev    next >
Encoding:
Text File  |  1987-04-01  |  18.8 KB  |  559 lines
  1. '┌───────────────────────────────────────────────────────────────────────────┐
  2. '│                               MC.BAS                                   │
  3. '│                             VERSION 1.0                                   │
  4. '│                                                                           │
  5. '│                           MODULE: MC6.INC                                 │
  6. '│                                                                           │
  7. '│                   Turbo Basic                     │
  8. '│        (C) Copyright 1987 by Borland International             │
  9. '│                                                                           │
  10. '│ DESCRIPTION: This module contains the routines to read, update, color and │
  11. '│        format cells. It also contains the Commands dispatcher.      │
  12. '└───────────────────────────────────────────────────────────────────────────┘
  13.  
  14. SUB ClearCells(Fx%, Fy%)
  15.   ' ClearCells clears the current cell and its associated cells.
  16.   ' An associated cell is a cell overwritten by data from the current
  17.   ' cell. The data can be text, in which case the cell has the attribute
  18.   ' field "overwritten." If the data is the result of an expression and
  19.   ' the field width is larger than 11 then the associated cell is
  20.   ' "Locked."
  21.  
  22.   LOCAL I%,CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%
  23.   SHARED Xpos%()
  24.   I% = Fx%
  25.  
  26.   DO   ' clear all cells that are NOT overwritten or blocked
  27.     LOCATE Fy% + 1, Xpos%(I%)
  28.     PRINT "           ";
  29.     INCR I% : IF i%>%FxMax THEN i%=%FxMax
  30.     CALL GetRec(I%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  31.   LOOP UNTIL ((FNIn%(%OverWritten ,CellStatus%)<>%True ) AND _
  32.              (FNIn%(%Locked ,CellStatus%)<>%True )) or (i%>=%FxMax)
  33. END SUB
  34.  
  35. SUB GotoX(X%, ColNo%, LineNo%)
  36.   ' GotoX the cursor's horizontal position
  37.   LOCATE LineNo%, X% + ColNo% - 1
  38. END SUB
  39.  
  40. SUB GetLine(ColNo%, LineNo%, Max%, UpperCase%, ErrorPosition%, S$)
  41.   ' GetLine is the routine used to GET input from the user. The
  42.   ' procedure allows editing of input and checks that the input
  43.   ' contains legal characters.
  44.  
  45.   LOCAL OkChars$, X%, InsertOn%
  46.   SHARED EofLine$,Numbers$,GetInt%,EditCellMode%
  47.  
  48.   IF Getint% THEN
  49.    OkChars$=Numbers$+"-"
  50.    S$=""
  51.   ELSE
  52.    FOR X% = 32 to 254  ' initialize the set of OK characters
  53.      OkChars$ =OkChars$+CHR$(X%)
  54.    NEXT X%
  55.   END IF
  56.  
  57.   InsertOn% = %TRUE
  58.   CharMov$=CHR$(5)+CHR$(24)+CHR$(19)+CHR$(4)
  59.  
  60.   CALL LowVideo
  61.   CALL GotoX(1, ColNo%, LineNo%)
  62.   PRINT S$;" ";
  63.   IF ErrorPosition%<>0 THEN
  64.     X% = ErrorPosition%
  65.   ELSEIF LEN(S$)=1 THEN
  66.     X%=2
  67.   ELSE
  68.     X%=1
  69.   END IF
  70.   DO
  71.     CALL GotoX(X%, ColNo%, LineNo%)
  72.     CALL ReadKBD(Char$)
  73.     CALL IbmCh(Char$)
  74.     IF UpperCase% = 1 THEN
  75.       Char$ = ucase$(Char$)
  76.     END IF
  77.     SELECT CASE left$(Char$, 1)
  78.       CASE CHR$(27)       ' ESC
  79.         S$ = CHR$(&HFF)   ' abort editing
  80.         Char$ = EofLine$
  81.       CASE CHR$(9)        ' tab Right
  82.         IF NOT ((X%>LEN(S$)) or (X%>Max%)) THEN
  83.           INCR X%
  84.         END IF
  85.       CASE CHR$(15)       ' tab Left
  86.         IF X%>1 THEN
  87.           decr X%
  88.         END IF
  89.       CASE CHR$(6)                ' move cursor to end of line
  90.         X% = LEN(S$) + 1
  91.       CASE CHR$(1)                ' move cursor to start of line
  92.         X% = 1
  93.       CASE CHR$(7)        ' delete char under cursor ^G
  94.         IF X% <= LEN(S$) THEN
  95.           CALL Delete(S$, X%, 1)
  96.           CALL GotoX(1, ColNo%, LineNo%)
  97.           PRINT S$;" ";
  98.         END IF
  99.       CASE CHR$(8)         ' delete char left cursor
  100.         IF (LEN(S$) > 0) AND (X% > 1) THEN
  101.           decr X%
  102.           CALL Delete(S$, X%, 1)
  103.           CALL GotoX(1, ColNo%, LineNo%)
  104.           PRINT S$;" ";
  105.         END IF
  106.       CASE CHR$(22)                ' toggle Insert/Overwrite
  107.         InsertOn% = NOT InsertOn%
  108.       CASE ELSE
  109.         IF FNInCharSet%(Char$,OkChars$) THEN
  110.            IF InsertOn%=%True  AND LEN(S$)<MAX% THEN
  111.               CALL Insert(Char$, S$, X%) : INCR X%
  112.            ELSEIF X%>LEN(S$) AND LEN(S$)<MAX% THEN
  113.               S$=S$+Char$ : INCR X%
  114.            ELSEIF X%<=MAX%  THEN
  115.                MID$(S$, X%, 1) = Char$ : INCR X%
  116.            END IF
  117.            CALL GotoX(1,ColNo%,LineNo%) : PRINT S$;" ";
  118.         END IF
  119.       END SELECT
  120.   LOOP UNTIL Char$ = EofLine$ or _
  121.            ((EditCellMode%=%True ) AND FNInCharSet%(Char$,CharMov$))
  122.   IF ((EditCellMode%=%True ) AND FNInCharSet%(Char$,CharMov$)) THEN
  123.     EditCellMode%=ASC(Char$)
  124.     Char$ = EofLine$
  125.   END IF
  126.   CALL NormVideo
  127. END SUB ' END procedure GetLine
  128.  
  129. SUB GetText(Fx%, Fy%, ErrorPosition%, S$)
  130.   ' GetText calls GetLine with the current cells X,Y positions as
  131.   ' parameters. This means that text entering takes place directly
  132.   ' in the cell's position on the screen.
  133.  
  134.   LOCAL LineLength%
  135.   SHARED Xpos%(),EditCellMode%
  136.  
  137.   Linelength% = (%FxMax-Fx%+1)*11
  138.   IF LineLength%>70 THEN LineLength%=70
  139.   CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  140.   CALL GetLine(Xpos%(Fx%), Fy% + 1, LineLength%, %FALSE , ErrorPosition%, S$)
  141. END SUB
  142.  
  143. SUB GetFormula(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, NewStatus%)
  144. ' GetFormula calls the routine GetLine to get a line from the user.
  145. ' It then calls the routine Evaluate to evaluate the formula input.
  146.  
  147.   SHARED EditCellMode%
  148.  
  149.   DO
  150.     CALL GetLine(1, 24, 70, %TRUE , ErrorPosition%, S$)
  151.     IF S$ <> CHR$(&HFF) THEN
  152.       CALL Evaluate(IsForm%, S$, EvalResult#, ErrorPosition%)
  153.       IF ErrorPosition% <> 0 THEN
  154.         CALL Flash(14, "Formula Error", %FALSE ) : BEEP
  155.       ELSE
  156.         CALL Flash(14, "             ", %FALSE )
  157.       END IF
  158.     END IF
  159.   LOOP UNTIL (ErrorPosition% = 0) or (S$ = CHR$(&HFF))
  160.   IF IsForm% THEN
  161.     CALL Addset(%Formula ,NewStatus%)
  162.   END IF
  163. END SUB
  164.  
  165.  
  166. SUB EditCell(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, NewStatus%)
  167.   ' EditCell loads a copy of the current cell's contents into the
  168.   ' variable S before calling either the procedure GetText or
  169.   ' GetFormula. In this way, no changes are actually made to the
  170.   ' current cell.
  171.  
  172.   SHARED  EditCellMode%
  173.  
  174.   CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  175.   S$ = Contents$
  176.   IF FN In%(%Txt , CellStatus%) THEN
  177.     CALL GetText(Fx%, Fy%, ErrorPosition% , S$ )
  178.   ELSE
  179.     CALL GetFormula(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, NewStatus%)
  180.   END IF
  181. END SUB
  182.  
  183.  
  184. SUB UpdateCells(Fx%, Fy%, IsForm%, ErrorPosition%, S$, EvalResult#, NewStatus%)
  185. ' UpdateCells is a bit more complicated than the previous routines.
  186. ' Basically it makes sure to tag and untag cells which have been
  187. ' over-written or cleared by data from another cell. It also updates
  188. ' the current cell with the new type and contents which are still in
  189. ' the temporary variable S$
  190.  
  191.   LOCAL I%, FLength%
  192.   SHARED NoPutReal#
  193.  
  194.   CALL PutRec(Fx%, Fy%, -1, S$, NoPutReal#, -1, -1, -1)
  195.   IF FN In%(%Txt , NewStatus%) THEN
  196.     I% = Fx%
  197.     FLength% = LEN(S$)
  198.     DO
  199.       IF I%<%FxMax THEN INCR I%
  200.       FLength% = FLength% - 11
  201.       IF FLength%>0 THEN
  202.         CALL AddSet(%OverWritten,CellStatus%)
  203.         CALL AddSet(%Txt,CellStatus%)
  204.         Contents$ = ""
  205.         CALL PutRec(I%, Fy%, CellStatus%, Contents$, NoPutReal#, -1, -1, -1)
  206.       ELSE
  207.         CALL GetRec(I%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  208.         IF FN In%(%OverWritten , CellStatus%) THEN
  209.           CellStatus% = %Txt
  210.           CALL PutRec(I%, Fy%, CellStatus%, CHR$(0), NoPutReal#, -1, -1,-1)
  211.           CALL GotoCell(I%, Fy%)
  212.           CALL LeaveCell(I%, Fy%)
  213.         END IF
  214.       END IF
  215.       CALL GetRec(I%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  216.     LOOP UNTIL (I% = %FxMax ) or (Contents$ <> "")
  217.     CellStatus% = %Txt
  218.     CALL PutRec(Fx%, Fy%, CellStatus%, CHR$(0), NoPutReal#, -1, -1,-1)
  219.   ELSE ' string changed to formula or constant
  220.  
  221.     I% = Fx%
  222.     DO
  223.       CALL GetRec(I%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  224.       IF FN In%(%OverWritten , CellStatus%) THEN
  225.         CellStatus% = %Txt
  226.         Contents$ = ""
  227.         CALL PutRec(I%, Fy%, CellStatus%, Contents$, NoPutReal#, -1, -1,-1)
  228.       END IF
  229.       INCR I%
  230.     LOOP UNTIL FNIn%(%OverWritten , CellStatus%)<>%True
  231.     CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  232.     CellStatus% = %Constant
  233.     IF IsForm% THEN
  234.       CALL AddSet(%Formula ,CellStatus%)
  235.     END IF
  236.     Value# = EvalResult#
  237.     CALL PutRec(Fx%, Fy%, CellStatus%, CHR$(0),Value#,-1,-1,-1)
  238.   END IF
  239. END SUB
  240.  
  241. SUB GetCell(Fx%, Fy%)
  242. ' procedure GetCell gets the contents of a cell from the user.
  243. ' This routine gets all input entered by the user. Procedure
  244. ' GetCell then initializes the temporary variable "S" with the last
  245. ' read character. Depending on this character, it then calls
  246. ' GetFormula, GetText, or EditCell.
  247.  
  248.   LOCAL S$, ErrorPosition%, NewStatus%, EvalResult#,I%,Abort%
  249.   SHARED Ch$,Autocalc%,NoPutReal#,EditCellMode%,GlobFx%,GlobFy%
  250.  
  251.   S$ = Ch$
  252.   ErrorPosition% = 0
  253.   Abort% = %FALSE
  254.   NewStatus% = 0
  255.   EvalResult# = NoPutReal#
  256.   Isform%=%False
  257.   EditCellMode% = %True
  258.  
  259.   IF FNInCharSet%(Ch$,"0123456789+-.()") THEN
  260.     NewStatus% = %Constant
  261.     CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  262.     IF FN In%(%Formula , CellStatus%)<>%True  THEN
  263.       CALL ClearStat
  264.       CALL ClearCells(Fx%, Fy%)
  265.       CALL GetFormula(FX%,FY%, IsForm%, ErrorPosition%, S$, EvalResult#, _
  266.               NewStatus%)
  267.     ELSE
  268.       CALL Flash(13, "Edit formula Y/N?", %TRUE )
  269.       DO
  270.         CALL ReadKBD(Char$)
  271.       LOOP UNTIL FNInCharSet%(ucase$(Char$),"YN")
  272.       CALL Flash(13, "                 ", %FALSE )
  273.       IF ucase$(Char$) = "Y" THEN
  274.         CALL EditCell(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, _
  275.               NewStatus%)
  276.       ELSE
  277.         Abort% = %TRUE
  278.       END IF
  279.     END IF
  280.   ELSE
  281.     CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  282.     IF Ch$ = CHR$(%EditKey ) THEN
  283.       CALL LeaveCell(Fx%,Fy%)
  284.       NewStatus% = 0
  285.       IF FNin%(%Txt ,CellStatus%) THEN CALL AddSet(%Txt ,NewStatus%)
  286.       IF FNin%(%Constant ,CellStatus%) THEN CALL AddSet(%Constant ,NewStatus%)
  287.       CALL EditCell(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, _
  288.                   NewStatus%)
  289.     ELSE
  290.       IF FN In%(%Formula , CellStatus%) THEN
  291.         CALL Flash(13, "Edit formula Y/N?", %TRUE )
  292.         DO
  293.           CALL ReadKBD(Char$)
  294.         LOOP UNTIL FNInCharSet%(ucase$(Char$),"YN")
  295.         CALL Flash(13, "                 ", %FALSE )
  296.         IF ucase$(Char$) = "Y" THEN
  297.           CALL EditCell(FX%,FY%,IsForm%, ErrorPosition%, S$, EvalResult#, _
  298.                   NewStatus%)
  299.         ELSE
  300.           Abort% = %TRUE
  301.         END IF
  302.       ELSE
  303.         NewStatus% = %Txt
  304.         CALL ClearCells(Fx%, Fy%)
  305.         CALL GetText(Fx%, Fy%, ErrorPosition% , S$ )
  306.       END IF
  307.     END IF
  308.   END IF
  309.   IF Abort%=%False  THEN  ' DO necessary updating
  310.     IF S$ <> CHR$(&HFF) THEN
  311.       CALL UpDateCells(Fx%, Fy%, IsForm%, ErrorPosition%, S$, EvalResult#, _
  312.                      NewStatus%)
  313.     END IF
  314.     CALL GotoCell(Fx%, Fy%)
  315.     CALL GetRec(Fx%, Fy%, CellStatus%, Contents$, Value#, Dec%, Fw%,CellColor%)
  316.     IF AutoCalc%=%True AND ( FNIn%(%Constant , CellStatus%) ) THEN
  317.        CALL Recalculate
  318.     END IF
  319.     IF FN In%(%Txt , NewStatus%) THEN
  320.       LOCATE Fy% + 1, 3
  321.       CALL ClrEol
  322.       FOR I% = %FxMax  to %FxMin  step -1
  323.         CALL LeaveCell(I%, Fy%)
  324.       NEXT I%
  325.     END IF
  326.   END IF
  327.   CALL Flash(13, "                  ", %FALSE )
  328.   SELECT CASE CHR$(EditCellMode%)
  329.     CASE CHR$(5)
  330.       CALL MoveUp
  331.     CASE CHR$(24)
  332.       CALL MoveDown
  333.     CASE CHR$(4)
  334.       CALL MoveRight
  335.     CASE CHR$(19)
  336.       CALL MoveLeft
  337.     CASE ELSE
  338.       CALL GotoCell(Fx%, Fy%)
  339.  END SELECT
  340.  EditCellMode%=%False
  341.  
  342. END SUB ' END procedure GetCell
  343.  
  344. SUB Format
  345.   ' procedure Format is used to modify the numeric format of a range of cells
  346.   ' in the current column
  347.  
  348.   LOCAL J%, FromLine%, ToLine%, Lock%, S$, D%, F%
  349.   SHARED Globfx%,Globfy%,Getint%,NoPutReal#
  350.  
  351.   GetInt%=%True
  352.   CALL NormVideo
  353.   CALL Msg("Column width (if larger than 11, next column will be locked) : ")
  354.   CALL GetLine(pos(0), csrlin, 2, %True , 0, S$)
  355.   IF S$<>CHR$(255) THEN
  356.      Fw%=VAL(S$)
  357.      IF Fw%<%FieldWidth  THEN Fw%=%FieldWidth  ELSE_
  358.         IF Fw%>22 AND GlobFx%<%FxMax  THEN Fw%=22 ELSE_
  359.            IF Fw%>11 AND GlobFx%>=%FxMax  THEN Fw%=11
  360.   END IF
  361.   CALL Msg("Number of Decimal (Max 11) enter -1 for scientific notation : ")
  362.   CALL GetLine(pos(0), csrlin, 2, %True , 0, S$)
  363.   IF S$<>CHR$(255) THEN
  364.      Dec%=VAL(S$)
  365.      IF Dec%<-1 THEN Dec%=-1 ELSE IF Dec%>11 THEN Dec%=11
  366.      IF Dec%+1 >= Fw% THEN Dec% = Dec% -1    ' handle # dec places = width
  367.   END IF
  368.   CALL Msg("From which line in column " + CHR$(GlobFx%) + " : ")
  369.   CALL GetLine(pos(0), csrlin, 2, %True , 0, S$)
  370.   IF S$<>CHR$(255) THEN
  371.     FromLine%=VAL(S$)
  372.     IF FromLine%<%FyMin  THEN FromLine%=%FyMin  ELSE_
  373.        IF FromLine%>%FyMax  THEN FromLine%=%FyMax
  374.     CALL Msg("To which line in column " + CHR$(GlobFx%) + " : ")
  375.     CALL GetLine(pos(0), csrlin, 2, %True , 0, S$)
  376.     IF S$<>CHR$(255) THEN
  377.       ToLine%=VAL(S$)
  378.       IF ToLine%<%FyMin  THEN
  379.         ToLine%=%FyMin
  380.       ELSEIF ToLine% > %FyMax  THEN
  381.         ToLine%=%FyMax
  382.       END IF
  383.       IF FromLine%>Toline% THEN SWAP FromLine%,Toline%
  384.       IF Fw% > 11 THEN
  385.         Lock% = %TRUE
  386.       ELSE
  387.         Lock% = %FALSE
  388.       END IF
  389.       FOR J% = FromLine% to ToLine%
  390.         CALL PutRec(GlobFx%, J%, -1, CHR$(0), NoPutReal#, Dec%, Fw%,-1)
  391.         IF GlobFx%<%FxMax  THEN
  392.           CALL GetRec(GlobFx%+1, J%, CellStatus%, Contents$, Value#, _
  393.                    D%,F%,CellColor%)
  394.           IF Lock% THEN
  395.             CALL AddSet(%Locked ,CellStatus%)
  396.             CALL AddSet(%Txt ,CellStatus%)
  397.             Contents$=""
  398.             CALL PutRec(GlobFx%+1, J%, CellStatus%, Contents$, NoPutReal#, _
  399.                        D%, F%,-1)
  400.           ELSE
  401.             CALL SubSet(%Locked ,CellStatus%)
  402.             CALL PutRec(GlobFx%+1, J%, CellStatus%, CHR$(0), NoPutReal#, _
  403.                        Dec%, Fw%,-1)
  404.           END IF
  405.         END IF
  406.       NEXT J%
  407.       CALL Update
  408.     END IF
  409.   END IF
  410.  
  411.   CALL GotoCell(GlobFx%,GlobFy%)
  412.   GetInt%=%False
  413.  
  414. END SUB ' END procedure Format
  415.  
  416. SUB GetCellColor
  417.  
  418.   LOCAL S$,C1%,C2%
  419.   SHARED GlobFx%,GlobFy%,Getint%,NoPutReal#,Enter$,ColorHelp%
  420.  
  421.   Getint%=%True : ColorHelp%=%False
  422.   CALL GetRec(GlobFx%, GlobFy%, CellStatus%, Contents$, Value#, Dec%, Fw%, CellColor%)
  423.   DO
  424.     CALL Msg("Enter foreground color number (1 to 31) or "+Enter$+_
  425.              " for Help : ")
  426.     CALL  GetLine(pos(0),csrlin,2,%True ,0,S$)
  427.     IF s$="" AND ColorHelp%=%false THEN CALL ColorHelp
  428.   LOOP UNTIL s$<>""
  429.   IF S$<>CHR$(255) THEN
  430.     C1%=VAL(S$)
  431.     IF C1%<0 or C1%>31 THEN C1%=CellColor% \ 256
  432.     DO
  433.       CALL Msg("Enter background color number (0 to 7) or "+Enter$+_
  434.                " for Help : ")
  435.       CALL  GetLine(pos(0),csrlin,2,%True ,0,S$)
  436.       IF s$="" AND ColorHelp%=%false THEN CALL ColorHelp
  437.     LOOP UNTIL s$<>""
  438.     IF S$<>CHR$(255) THEN
  439.       C2%=VAL(S$)
  440.       IF C2%<0 or C2%>7 THEN C2%=CellColor% mod 256
  441.       IF (C1%<>0 or C2%<>0) AND (C1%<>0 or C2%<>7) THEN
  442.          CellColor%=C1%*256+C2%
  443.       END IF
  444.       CALL PutRec(GlobFx%, GlobFy%, -1, CHR$(0), NoPutReal#, -1, -1, _
  445.           CellColor%)
  446.       CALL LeaveCell(GlobFx%,GlobFy%)
  447.     END IF
  448.   END IF
  449.   Getint%=0
  450.   IF ColorHelp%=%True THEN CALL update
  451. END SUB
  452.  
  453. SUB ColorHelp
  454.  
  455.   LOCAL i%,j%
  456.   SHARED ColorHelp%
  457.  
  458.   ColorHelp%=%True
  459.   COLOR 10,0
  460.   LOCATE 4,4
  461.   PRINT "┌"+STRING$(71,"─")+"┐"
  462.   COLOR 0,10 : LOCATE 4,33 : PRINT "  Color patterns  " : COLOR 10,0
  463.   FOR i%=1 to 16
  464.     LOCATE ,4  : PRINT "│"+SPACE$(71);"│"
  465.   NEXT
  466.   LOCATE ,4 : PRINT "└"+STRING$(71,"─")+"┘"
  467.   COLOR 15,0 : LOCATE 6,7
  468.   PRINT "                       1                   2                   3  "
  469.   LOCATE ,7
  470.   PRINT "   0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1"
  471.   LOCATE ,7 : COLOR 7,0
  472.   PRINT " ┌"+STRING$(65,"─")+"┐"
  473.   FOR i%=0 to 7
  474.     LOCATE ,7
  475.     COLOR 15,0 : PRINT using "#";i%;
  476.     COLOR 7,0 : PRINT "│";
  477.     FOR j%=0 to 31
  478.       COLOR j%,i% : PRINT " ";CHR$(4);
  479.     NEXT
  480.     PRINT " ";
  481.     COLOR 7,0 : PRINT "│"
  482.   NEXT
  483.   LOCATE ,7 : PRINT " └"+STRING$(65,"─")+"┘"
  484.   COLOR 10,0 : PRINT
  485.   LOCATE ,6 : PRINT " Numbers 0-31 FOR foreground color, ";
  486.   PRINT "Numbers 0-7 for background color"
  487.   CALL NormVideo
  488. END SUB
  489.  
  490. SUB Commands
  491. ' procedure Commands is called from the programs main loop when the user
  492. ' types "/" The procedure in turn calls the appropriate procedure based
  493. ' on the user's response to the menu displayed.
  494.  
  495.   SHARED GLOBFX%,GLOBFY%,CalcExit%,Border%,FileName$,BeginTimer
  496.  
  497.   LOCATE 24, 1
  498.   COLOR %HighLightColor,0 : PRINT "A"; : COLOR %NormColor,0 : PRINT "uto,";
  499.   COLOR %HighLightColor,0 : PRINT "B"; : COLOR %NormColor,0 : PRINT "order,";
  500.   COLOR %HighLightColor,0 : PRINT "C"; : COLOR %NormColor,0 : PRINT "olor,";
  501.   COLOR %HighLightColor,0 : PRINT "D"; : COLOR %NormColor,0 : PRINT "os,";
  502.   COLOR %HighLightColor,0 : PRINT "F"; : COLOR %NormColor,0 : PRINT "ormat,";
  503.   COLOR %HighLightColor,0 : PRINT "G"; : COLOR %NormColor,0 : PRINT "oto,";
  504.   COLOR %HighLightColor,0 : PRINT "H"; : COLOR %NormColor,0 : PRINT "elp,";
  505.   COLOR %HighLightColor,0 : PRINT "I"; : COLOR %NormColor,0 : PRINT "nit,";
  506.   COLOR %HighLightColor,0 : PRINT "L"; : COLOR %NormColor,0 : PRINT "oad,";
  507.   COLOR %HighLightColor,0 : PRINT "P"; : COLOR %NormColor,0 : PRINT "rint,";
  508.   COLOR %HighLightColor,0 : PRINT "Q"; : COLOR %NormColor,0 : PRINT "uit,";
  509.   COLOR %HighLightColor,0 : PRINT "R"; : COLOR %NormColor,0 : PRINT "ecalc,";
  510.   COLOR %HighLightColor,0 : PRINT "S"; : COLOR %NormColor,0 : PRINT "ave,";
  511.   COLOR %HighLightColor,0 : PRINT "U"; : COLOR %NormColor,0 : PRINT "pdate";
  512.   PRINT "?";
  513.   CALL ReadKBD(Char$)
  514.   Char$ = ucase$(Char$)
  515.   SELECT CASE Char$     '
  516.     CASE "Q"
  517.       CalcExit%=%True   ' EXIT from the calc
  518.     CASE "F"
  519.       CALL Format       ' format a range of cells
  520.     CASE "S"
  521.       CALL save         ' save the current spreadsheet to a file
  522.     CASE "L"
  523.       FileName$=""
  524.       CALL load         ' load a spreadsheet from a file
  525.     CASE "H"
  526.       CALL Help         ' CALL the help procedure
  527.       CALL Update
  528.     CASE "R"
  529.       CALL Recalculate  ' recalculate the spreadsheet
  530.     CASE "A"
  531.       CALL Auto         ' toggle AutoCalc ON/OFF
  532.     CASE "U"
  533.       CALL Update       ' redraw the screen
  534.     CASE "I"
  535.       CALL ClearSheet   ' clear spreadsheet
  536.     CASE "P"
  537.       CALL PrintSheet   ' PRINT spreadsheet to file or printer
  538.     CASE "B"            ' Border on/off
  539.       Border%=NOT Border%
  540.       CALL Update
  541.     CASE "D"            ' Dos access
  542.       CALL DosShell
  543.       CALL Update
  544.     CASE "G"
  545.       CALL  MoveToCell
  546.     CASE "C"
  547.       CALL  GetCellColor
  548.     CASE ELSE
  549.       Char$=""          ' No more command available
  550.   END SELECT
  551.   IF CalcExit% THEN
  552.      CLS
  553.   ELSE
  554.      CALL Grid
  555.      CALL GotoCell(GlobfX%, GlobFY%)
  556.   END IF
  557.  
  558. END SUB
  559.