home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo4 / mcommand.pas < prev    next >
Pascal/Delphi Source File  |  1987-12-08  |  21KB  |  780 lines
  1.  
  2. {           Copyright (c) 1985, 87 by Borland International, Inc.            }
  3.  
  4. unit MCOMMAND;
  5.  
  6. interface
  7.  
  8. uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser, MCLib, MCInput;
  9.  
  10. procedure CheckForSave;
  11. { fragt zurück, ob das Rechenblatt nach Veränderungen gespeichert werden soll }
  12.  
  13. procedure MoveRowUp;       { eine Zeile aufwärts }
  14. procedure MoveRowDown;     { eine Zeile abwärts }
  15. procedure MoveColLeft;     { eine Spalte nach links }
  16. procedure MoveColRight;    { eine Spalten nach rechts }
  17.  
  18. procedure EditCell(ECell : CellPtr);   { verändert einen Zellinhalt }
  19.  
  20. procedure ClearSheet;   { löscht das momentane Rechenblatt }
  21. procedure LoadSheet(FileName : IString);  { lädt ein Rechenblatt }
  22. procedure SaveSheet;                      { speichert das momentane Rechenblatt }
  23.  
  24. function PageRows(Row : Word; TopPage, Border : Boolean) : Word;
  25. { ermittelt die Anzahl der auszudruckenden Spalten }
  26. function PageCols(Col, Columns : Word; Border : Boolean) : Word;
  27. { ermittelt die Anzahl der auszudruckenden Zeilen }
  28. procedure PrintSheet;
  29. { gibt das Rechenblatt auf einen Drucker oder in eine Datei aus }
  30.  
  31. procedure SetColWidth(Col : Word);    { setzt die Breite einer Spalte }
  32.  
  33. procedure GotoCell;        { setzt den Cursor auf eine bestimmte Zelle }
  34.  
  35. procedure FormatCells;     { formatiert einen Zellbereich interaktiv }
  36.  
  37. procedure DeleteCol(Col : Word);  { löscht eine Spalte }
  38. procedure InsertCol(Col : Word);  { fügt eine Spalte ein }
  39. procedure DeleteRow(Row : Word);  { löscht eine Zeile }
  40. procedure InsertRow(Row : Word);  { fügt eine Zeile ein }
  41.  
  42. procedure SMenu;         { Menü "Rechenblatt" }
  43. procedure CMenu;         { Menü "Spalte" }
  44. procedure RMenu;         { Menü "Zeile" }
  45. procedure UMenu;         { Menü "Diverses" }
  46. procedure MainMenu;      { Hauptmenü }
  47.  
  48. { ********************************************************** }
  49. { ********************************************************** }
  50. implementation
  51.  
  52. const
  53.   Name : String[80] = MSGNAME;
  54.  
  55. var
  56.   Rec : CellRec;
  57.  
  58. procedure CheckForSave;
  59. var
  60.   Save : Char;
  61. begin
  62.   if Changed and GetYesNo(Save, MSGSAVESHEET)
  63.      and (Save = 'J') then SaveSheet;
  64. end;
  65.  
  66. procedure MoveRowUp;
  67. begin
  68.   DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
  69.   if CurRow > TopRow then Dec(CurRow)
  70.   else if TopRow > 1 then
  71.   begin
  72.     Scroll(DOWN, 1, Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
  73.     Dec(TopRow);
  74.     DisplayRow(TopRow, NOUPDATE);
  75.     Dec(CurRow);
  76.     SetBottomRow;
  77.   end;
  78. end;
  79.  
  80. procedure MoveRowDown;
  81. begin
  82.   DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
  83.   if CurRow < BottomRow then Inc(CurRow)
  84.   else if BottomRow < MAXROWS then
  85.   begin
  86.     Scroll(UP, 1, Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
  87.     Inc(TopRow);
  88.     Inc(CurRow);
  89.     SetBottomRow;
  90.     DisplayRow(BottomRow, NOUPDATE);
  91.   end;
  92. end;
  93.  
  94. procedure MoveColLeft;
  95. var
  96.   Col, OldLeftCol : Word;
  97.   OldColStart : array[1..SCREENCOLS] of Byte;
  98. begin
  99.   OldLeftCol := LeftCol;
  100.   Move(ColStart, OldColStart, Sizeof(ColStart));
  101.   DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
  102.   if (CurCol > LeftCol) then Dec(CurCol)
  103.   else if (LeftCol <> 1) then
  104.   begin
  105.     Dec(CurCol);
  106.     Dec(LeftCol);
  107.     SetRightCol;
  108.     SetLeftCol;
  109.     if OldLeftCol <= RightCol then
  110.       Scroll(RIGHT, Pred(ColStart[Succ(OldLeftCol - LeftCol)] - LEFTMARGIN),
  111.              Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
  112.     ClearLastCol;
  113.     for Col := LeftCol to Pred(OldLeftCol) do
  114.       DisplayCol(Col, NOUPDATE);
  115.   end;
  116. end;
  117.  
  118. procedure MoveColRight;
  119. var
  120.   Col, OldLeftCol, OldRightCol : Word;
  121.   OldColStart : array[1..SCREENCOLS] of Byte;
  122. begin
  123.   OldLeftCol := LeftCol;
  124.   Move(ColStart, OldColStart, Sizeof(ColStart));
  125.   OldRightCol := RightCol;
  126.   DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
  127.   if CurCol < RightCol then Inc(CurCol)
  128.   else if RightCol < MAXCOLS then
  129.   begin
  130.     Inc(CurCol);
  131.     Inc(RightCol);
  132.     SetLeftCol;
  133.     SetRightCol;
  134.     if OldRightCol >= LeftCol then
  135.       Scroll(LEFT, Pred(OldColStart[Succ(LeftCol - OldLeftCol)] - LEFTMARGIN),
  136.              Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
  137.     ClearLastCol;
  138.     for Col := Succ(OldRightCol) to RightCol do
  139.       DisplayCol(Col, NOUPDATE);
  140.   end;
  141. end;
  142.  
  143. procedure EditCell;
  144. var
  145.   S : IString;
  146. begin
  147.   if ECell = nil then Exit;
  148.   case ECell^.Attrib of
  149.     TXT : S := ECell^.T;
  150.     VALUE : Str(ECell^.Value:1:MAXPLACES, S);
  151.     FORMULA : S := ECell^.Formula;
  152.   end; { case }
  153.   if (not EditString(S, '', MAXINPUT)) or (S = '') then Exit;
  154.   Act(S);
  155.   Changed := True;
  156. end;
  157.  
  158. procedure ClearSheet;
  159. var
  160.   Col, Row : Word;
  161. begin
  162.   for Row := 1 to LastRow do
  163.   begin
  164.     for Col := 1 to LastCol do
  165.       DeleteCell(Col, Row, NOUPDATE);
  166.   end;
  167.   InitVars;
  168.   SetRightCol;
  169.   SetBottomRow;
  170.   DisplayScreen(NOUPDATE);
  171.   PrintFreeMem;
  172.   Changed := False;
  173. end;
  174.  
  175. procedure LoadSheet;
  176. var
  177.   Dummy, Size, RealLastCol, RealLastRow : Word;
  178.   F : File;
  179.   Check : String[80];
  180.   Allocated : Boolean;
  181.   Blocks : Word;
  182.   RealSize : Byte;
  183. begin
  184.   RealLastCol := 1;
  185.   RealLastRow := 1;
  186.   if FileName = '' then
  187.   begin
  188.     WritePrompt(MSGFILENAME);
  189.     if not EditString(FileName, '', MAXINPUT) then
  190.       Exit;
  191.   end;
  192.   if not Exists(FileName) then
  193.   begin
  194.     ErrorMsg(MSGNOEXIST);
  195.     Exit;
  196.   end;
  197.   Assign(F, FileName);
  198.   Reset(F, 1);
  199.   if IOResult <> 0 then
  200.   begin
  201.     ErrorMsg(MSGNOOPEN);
  202.     Exit;
  203.   end;
  204.   BlockRead(F, Check[1], Length(Name), Blocks);
  205.   Check[0] := Chr(Length(Name));
  206.   if Check <> Name then
  207.   begin
  208.     ErrorMsg(MSGNOMICROCALC);
  209.     Close(F);
  210.     Exit;
  211.   end;
  212.   BlockRead(F, Size, 1, Blocks);
  213.   BlockRead(F, RealSize, 1, Blocks);
  214.   if RealSize <> SizeOf(Real) then
  215.   begin
  216.     ErrorMsg(MSGBADREALS);
  217.     Close(F);
  218.     Exit;
  219.   end;
  220.   SetColor(PROMPTCOLOR);
  221.   GotoXY(1, ScreenRows + 5);
  222.   Write(MSGLOADING);
  223.   GotoXY(Succ(Length(MSGLOADING)), ScreenRows + 5);
  224.   ClearSheet;
  225.   BlockRead(F, LastCol, SizeOf(LastCol), Blocks);
  226.   BlockRead(F, LastRow, SizeOf(LastRow), Blocks);
  227.   BlockRead(F, Size, SizeOf(Size), Blocks);
  228.   BlockRead(F, ColWidth, Sizeof(ColWidth), Blocks);
  229.   repeat
  230.     BlockRead(F, CurCol, SizeOf(CurCol), Blocks);
  231.     BlockRead(F, CurRow, SizeOf(CurRow), Blocks);
  232.     BlockRead(F, Format[CurCol, CurRow], 1, Blocks);
  233.     BlockRead(F, Size, SizeOf(Size), Blocks);
  234.     BlockRead(F, Rec, Size, Blocks);
  235.     case Rec.Attrib of
  236.       TXT : begin
  237.         Allocated := AllocText(CurCol, CurRow, Rec.T);
  238.         if Allocated then
  239.           Dummy := SetOFlags(CurCol, CurRow, NOUPDATE);
  240.       end;
  241.       VALUE : Allocated := AllocValue(CurCol, CurRow, Rec.Value);
  242.       FORMULA : Allocated := AllocFormula(CurCol, CurRow, Rec.Formula,
  243.                                           Rec.Fvalue);
  244.     end; { case }
  245.     if not Allocated then
  246.     begin
  247.       ErrorMsg(MSGFILELOMEM);
  248.       LastRow := RealLastRow;
  249.       LastCol := RealLastCol;
  250.       Format[CurCol, CurRow] := DEFAULTFORMAT;
  251.     end
  252.     else begin
  253.       Cell[CurCol, CurRow]^.Error := Rec.Error;
  254.       if CurCol > RealLastCol then
  255.         RealLastCol := CurCol;
  256.       if CurRow > RealLastRow then
  257.         RealLastRow := CurRow;
  258.     end;
  259.   until (not Allocated) or (EOF(F));
  260.   PrintFreeMem;
  261.   Close(F);
  262.   CurCol := 1;
  263.   CurRow := 1;
  264.   SetRightCol;
  265.   DisplayScreen(NOUPDATE);
  266.   SetColor(White);
  267.   GotoXY(1, ScreenRows + 5);
  268.   ClrEol;
  269.   Changed := False;
  270. end;
  271.  
  272. procedure SaveSheet;
  273. var
  274.   FileName : IString;
  275.   EndOfFile, Overwrite : Char;
  276.   Size, Col, Row : Word;
  277.   F : File;
  278.   CPtr : CellPtr;
  279.   Blocks : Word;
  280.   RealSize : Byte;
  281. begin
  282.   EndOfFile := #26;
  283.   FileName := '';
  284.   RealSize := SizeOf(Real);
  285.   WritePrompt(MSGFILENAME);
  286.   if not EditString(FileName, '', MAXINPUT) then
  287.     Exit;
  288.   Assign(F, FileName);
  289.   if Exists(FileName) then
  290.   begin
  291.     if (not GetYesNo(Overwrite, MSGOVERWRITE))
  292.       or (Overwrite = 'N') then Exit;
  293.     Reset(F, 1);
  294.   end
  295.   else
  296.     Rewrite(F, 1);
  297.   if IOResult <> 0 then
  298.   begin
  299.     ErrorMsg(MSGNOOPEN);
  300.     Exit;
  301.   end;
  302.   SetColor(PROMPTCOLOR);
  303.   GotoXY(1, ScreenRows + 5);
  304.   Write(MSGSAVING);
  305.   GotoXY(Length(MSGSAVING) + 1, ScreenRows + 5);
  306.   BlockWrite(F, Name[1], Length(Name), Blocks);
  307.   BlockWrite(F, EndOfFile, 1, Blocks);
  308.   BlockWrite(F, RealSize, 1, Blocks);
  309.   BlockWrite(F, LastCol, SizeOf(LastCol), Blocks);
  310.   BlockWrite(F, LastRow, SizeOf(LastRow), Blocks);
  311.   Size := MAXCOLS;
  312.   BlockWrite(F, Size, SizeOf(Size), Blocks);
  313.   BlockWrite(F, ColWidth, Sizeof(ColWidth), Blocks);
  314.   for Row := 1 to LastRow do
  315.   begin
  316.     for Col := LastCol downto 1 do
  317.     begin
  318.       if Cell[Col, Row] <> nil then
  319.       begin
  320.         CPtr := Cell[Col, Row];
  321.         case CPtr^.Attrib of
  322.           TXT : Size := Length(CPtr^.T) + 3;
  323.           VALUE : Size := Sizeof(Real) + 2;
  324.           FORMULA : Size := Length(CPtr^.Formula) + Sizeof(Real) + 3;
  325.         end; { case }
  326.         BlockWrite(F, Col, SizeOf(Col), Blocks);
  327.         BlockWrite(F, Row, SizeOf(Row), Blocks);
  328.         BlockWrite(F, Format[Col, Row], 1, Blocks);
  329.         BlockWrite(F, Size, SizeOf(Size), Blocks);
  330.         BlockWrite(F, CPtr^, Size, Blocks);
  331.       end;
  332.     end;
  333.   end;
  334.   Close(F);
  335.   SetColor(White);
  336.   GotoXY(1, ScreenRows + 5);
  337.   ClrEol;
  338.   Changed := False;
  339. end;
  340.  
  341. function PageRows;
  342. var
  343.   Rows : Word;
  344. begin
  345.   if TopPage then Rows := 66 - TOPMARGIN
  346.    else Rows := 66;
  347.   if Border then Dec(Rows);
  348.   if Pred(Row + Rows) > LastRow then PageRows := Succ(LastRow - Row)
  349.    else PageRows := Rows;
  350. end;
  351.  
  352. function PageCols;
  353. var
  354.   Len : Integer;
  355.   FirstCol : Word;
  356. begin
  357.   if (Col = 1) and Border then Len := Columns - LEFTMARGIN
  358.    else Len := Columns;
  359.   FirstCol := Col;
  360.   while (Len > 0) and (Col <= LastCol) do
  361.   begin
  362.     Dec(Len, ColWidth[Col]);
  363.     Inc(Col);
  364.   end;
  365.   if Len < 0 then Dec(Col);
  366.   PageCols := Col - FirstCol;
  367. end;
  368.  
  369. procedure PrintSheet;
  370. var
  371.   FileName : IString;
  372.   S : String[132];
  373.   ColStr : String[MAXCOLWIDTH];
  374.   F : Text;
  375.   Columns, Counter1, Counter2, Counter3, Col, Row, LCol, LRow, Dummy,
  376.     Printed, OldLastCol : Word;
  377.   Answer : Char;
  378.   Border, TopPage : Boolean;
  379. begin
  380.   Col := 1;
  381.   WritePrompt(MSGPRINT);
  382.   FileName := '';
  383.   if not EditString(FileName, '', MAXINPUT) then Exit;
  384.   if FileName = '' then
  385.     FileName := 'PRN';
  386.   Assign(F, FileName);
  387. {$I-}
  388.   Rewrite(F);
  389.   if IOResult <> 0 then
  390.   begin
  391.     ErrorMsg(MSGNOOPEN);
  392.     Exit;
  393.   end;
  394. {$I+}
  395.   OldLastCol := LastCol;
  396.   for Counter1 := 1 to LastRow do
  397.   begin
  398.     for Counter2 := LastCol to MAXCOLS do
  399.     begin
  400.       if Format[Counter2, Counter1] >= OVERWRITE then
  401.         LastCol := Counter2;
  402.     end;
  403.   end;
  404.   if not GetYesNo(Answer, MSGCOLUMNS) then Exit;
  405.   if Answer = 'J' then Columns := 132
  406.    else Columns := 80;
  407.   if not GetYesNo(Answer, MSGBORDER) then Exit;
  408.   Border := Answer = 'J';
  409.   while Col <= LastCol do
  410.   begin
  411.     Row := 1;
  412.     TopPage := True;
  413.     LCol := PageCols(Col, Columns, Border) + Col;
  414.     while Row <= LastRow do
  415.     begin
  416.       LRow := PageRows(Row, TopPage, Border) + Row;
  417.       Printed := 0;
  418.       if TopPage then
  419.       begin
  420.         for Counter1 := 1 to TOPMARGIN do
  421.         begin
  422.           Writeln(F);
  423.           Inc(Printed);
  424.         end;
  425.       end;
  426.       for Counter1 := Row to Pred(LRow) do
  427.       begin
  428.         if Border and (Counter1 = Row) and (TopPage) then
  429.         begin
  430.           if (Col = 1) and Border then
  431.           begin
  432.             S[0] := Chr(LEFTMARGIN);
  433.             FillChar(S[1], LEFTMARGIN, ' ');
  434.           end
  435.            else S := '';
  436.           for Counter3 := Col to Pred(LCol) do
  437.           begin
  438.             ColStr := CenterColString(Counter3);
  439.             S := S + ColStr;
  440.           end;
  441.           Writeln(F, S);
  442.           Printed := Succ(Printed);
  443.         end;
  444.         if (Col = 1) and Border then
  445.             S := Pad(WordToString(Counter1, 1), LEFTMARGIN)
  446.         else S := '';
  447.         for Counter2 := Col to Pred(LCol) do
  448.           S := S + CellString(Counter2, Counter1, Dummy, DOFORMAT);
  449.         Writeln(F, S);
  450.         Inc(Printed);
  451.       end;
  452.       Row := LRow;
  453.       TopPage := False;
  454.       if Printed < 66 then
  455.         Write(F, FORMFEED);
  456.     end;
  457.     Col := LCol;
  458.   end;
  459.   Close(F);
  460.   LastCol := OldLastCol;
  461. end;
  462.  
  463. procedure SetColWidth;
  464. var
  465.   Width, Row : Word;
  466. begin
  467.   WritePrompt(MSGCOLWIDTH);
  468.   if not GetWord(Width, MINCOLWIDTH, MAXCOLWIDTH) then Exit;
  469.   ColWidth[Col] := Width;
  470.   SetRightCol;
  471.   if RightCol < Col then
  472.   begin
  473.     RightCol := Col;
  474.     SetLeftCol;
  475.     SetRightCol;
  476.   end;
  477.   for Row := 1 to LastRow do
  478.   begin
  479.     if (Cell[Col, Row] <> nil) and (Cell[Col, Row]^.Attrib = TXT) then
  480.       ClearOFlags(Succ(Col), Row, NOUPDATE)
  481.     else ClearOFlags(Col, Row, NOUPDATE);
  482.     UpdateOFlags(Col, Row, NOUPDATE);
  483.   end;
  484.   DisplayScreen(NOUPDATE);
  485.   Changed := True;
  486. end;
  487.  
  488. procedure GotoCell;
  489. begin
  490.   WritePrompt(MSGGOTO);
  491.   if not GetCell(CurCol, CurRow) then Exit;
  492.   LeftCol := CurCol;
  493.   TopRow := CurRow;
  494.   SetBottomRow;
  495.   SetRightCol;
  496.   SetLeftCol;
  497.   DisplayScreen(NOUPDATE);
  498. end;
  499.  
  500. procedure FormatCells;
  501. var
  502.   Col, Row, Col1, Col2, Row1, Row2, NewFormat, ITemp : Word;
  503.   Temp : Char;
  504. begin
  505.   NewFormat := 0;
  506.   WritePrompt(MSGCELL1);
  507.   if not GetCell(Col1, Row1) then Exit;
  508.   WritePrompt(MSGCELL2);
  509.   if not GetCell(Col2, Row2) then Exit;
  510.   if (Col1 <> Col2) and (Row1 <> Row2) then ErrorMsg(MSGDIFFCOLROW)
  511.   else begin
  512.     if Col1 > Col2 then Switch(Col1, Col2);
  513.     if Row1 > Row2 then Switch(Row1, Row2);
  514.     if not GetYesNo(Temp, MSGRIGHTJUST) then Exit;
  515.     NewFormat := NewFormat + (Ord(Temp = 'J') * RJUSTIFY);
  516.     if not GetYesNo(Temp, MSGDOLLAR) then Exit;
  517.     NewFormat := NewFormat + (Ord(Temp = 'J') * DOLLAR);
  518.     if not GetYesNo(Temp, MSGCOMMAS) then Exit;
  519.     NewFormat := NewFormat + (Ord(Temp = 'J') * COMMAS);
  520.     if (NewFormat and DOLLAR) <> 0 then  NewFormat := NewFormat + 2
  521.      else begin
  522.        WritePrompt(MSGPLACES);
  523.        if not GetWord(ITemp, 0, MAXPLACES) then Exit;
  524.        NewFormat := NewFormat + ITemp;
  525.      end;
  526.     for Col := Col1 to Col2 do
  527.     begin
  528.       for Row := Row1 to Row2 do
  529.       begin
  530.         Format[Col, Row] := (Format[Col, Row] and OVERWRITE) or NewFormat;
  531.         if (Col >= LeftCol) and (Col <= RightCol) and
  532.            (Row >= TopRow) and (Row <= BottomRow) then
  533.         DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
  534.       end;
  535.     end;
  536.   end;
  537.   Changed := True;
  538. end;
  539.  
  540. procedure DeleteCol;
  541. var
  542.   OldLastCol, Counter, Row : Word;
  543. begin
  544.   if Col > LastCol then Exit;
  545.   OldLastCol := LastCol;
  546.   for Counter := 1 to LastRow do
  547.     DeleteCell(Col, Counter, NOUPDATE);
  548.   PrintFreeMem;
  549.   if Col <> OldLastCol then
  550.   begin
  551.     Move(Cell[Succ(Col), 1], Cell[Col, 1], MAXROWS * Sizeof(CellPtr) *
  552.          (OldLastCol - Col));
  553.     Move(Format[Succ(Col), 1], Format[Col, 1], MAXROWS * (OldLastCol - Col));
  554.     Move(ColWidth[Succ(Col)], ColWidth[Col], OldLastCol - Col);
  555.   end;
  556.   FillChar(Cell[OldLastCol, 1], MAXROWS * Sizeof(CellPtr), 0);
  557.   FillChar(Format[OldLastCol, 1], MAXROWS, DEFAULTFORMAT);
  558.   ColWidth[OldLastCol] := DEFAULTWIDTH;
  559.   SetRightCol;
  560.   if CurCol > RightCol then
  561.   begin
  562.     Inc(RightCol);
  563.     SetLeftCol;
  564.   end;
  565.   ClearLastCol;
  566.   if OldLastCol = LastCol then Dec(LastCol);
  567.   for Counter := 1 to LastCol do
  568.   begin
  569.     for Row := 1 to LastRow do
  570.     begin
  571.       if (Cell[Counter, Row] <> nil) and
  572.          (Cell[Counter, Row]^.Attrib = FORMULA) then
  573.         FixFormula(Counter, Row, COLDEL, Col);
  574.       UpdateOFlags(Col, Row, NOUPDATE);
  575.     end;
  576.   end;
  577.   for Counter := Col to RightCol do
  578.     DisplayCol(Counter, NOUPDATE);
  579.   LastCol := MAXCOLS;
  580.   SetLastCol;
  581.   Changed := True;
  582.   Recalc;
  583. end;
  584.  
  585. procedure InsertCol;
  586. var
  587.   Counter, Row : Word;
  588. begin
  589.   if (LastCol = MAXCOLS) or (Col > LastCol) then Exit;
  590.   if Col <> LastCol then
  591.   begin
  592.     Move(Cell[Col, 1], Cell[Col + 1, 1], MAXROWS * Sizeof(CellPtr) *
  593.            Succ(LastCol - Col));
  594.     Move(Format[Col, 1], Format[Col + 1, 1], MAXROWS * Succ(LastCol - Col));
  595.     Move(ColWidth[Col], ColWidth[Col + 1], Succ(LastCol - Col));
  596.   end;
  597.   if LastCol < MAXCOLS then Inc(LastCol);
  598.   FillChar(Cell[Col, 1], MAXROWS * Sizeof(CellPtr), 0);
  599.   FillChar(Format[Col, 1], MAXROWS, DEFAULTFORMAT);
  600.   ColWidth[Col] := DEFAULTWIDTH;
  601.   SetRightCol;
  602.   if CurCol > RightCol then
  603.   begin
  604.     Inc(RightCol);
  605.     SetLeftCol;
  606.   end;
  607.   for Counter := 1 to LastCol do
  608.     for Row := 1 to LastRow do
  609.     begin
  610.       if (Cell[Counter, Row] <> nil) and
  611.          (Cell[Counter, Row]^.Attrib = FORMULA) then
  612.         FixFormula(Counter, Row, COLADD, Col);
  613.       UpdateOFlags(Col, Row, NOUPDATE);
  614.     end;
  615.   for Counter := Col to RightCol do
  616.     DisplayCol(Counter, NOUPDATE);
  617.   LastCol := MAXCOLS; SetLastCol; Changed := True; Recalc;
  618. end;
  619.  
  620. procedure DeleteRow;
  621. var
  622.   OldLastRow, Counter, RowC : Word;
  623. begin
  624.   if Row > LastRow then Exit;
  625.   OldLastRow := LastRow;
  626.   for Counter := 1 to LastCol do
  627.     DeleteCell(Counter, Row, NOUPDATE);
  628.   PrintFreeMem;
  629.   if Row <> OldLastRow then
  630.     for Counter := 1 to MAXCOLS do
  631.     begin
  632.       Move(Cell[Counter, Succ(Row)], Cell[Counter, Row],
  633.            Sizeof(CellPtr) * (OldLastRow - Row));
  634.       Move(Format[Counter, Succ(Row)], Format[Counter, Row],
  635.            OldLastRow - Row);
  636.     end;
  637.   for Counter := 1 to LastCol do
  638.   begin
  639.     Cell[Counter, OldLastRow] := nil;
  640.     Format[Counter, OldLastRow] := DEFAULTFORMAT;
  641.   end;
  642.   if OldLastRow = LastRow then Dec(LastRow);
  643.   for Counter := 1 to LastCol do
  644.     for RowC := 1 to LastRow do
  645.     begin
  646.       if (Cell[Counter, RowC] <> nil) and
  647.          (Cell[Counter, RowC]^.Attrib = FORMULA) then
  648.         FixFormula(Counter, RowC, ROWDEL, Row);
  649.     end;
  650.   for Counter := Row to BottomRow do
  651.     DisplayRow(Counter, NOUPDATE);
  652.   LastRow := MAXROWS; SetLastRow; Changed := True; Recalc;
  653. end;
  654.  
  655. procedure InsertRow;
  656. var
  657.   Counter, RowC : Word;
  658. begin
  659.   if (LastRow = MAXROWS) or (Row > LastRow) then Exit;
  660.   if Row <> LastRow then
  661.     for Counter := 1 to MAXCOLS do
  662.     begin
  663.       Move(Cell[Counter, Row], Cell[Counter, Succ(Row)],
  664.            Sizeof(CellPtr) * Succ(LastRow - Row));
  665.       Move(Format[Counter, Row], Format[Counter, Succ(Row)],
  666.            Succ(LastRow - Row));
  667.     end;
  668.   Inc(LastRow);
  669.   for Counter := 1 to LastCol do
  670.   begin
  671.     Cell[Counter, Row] := nil;
  672.     Format[Counter, Row] := DEFAULTFORMAT;
  673.   end;
  674.   for Counter := 1 to LastCol do
  675.     for RowC := 1 to LastRow do
  676.     begin
  677.       if (Cell[Counter, RowC] <> nil) and
  678.          (Cell[Counter, RowC]^.Attrib = FORMULA) then
  679.         FixFormula(Counter, RowC, ROWADD, Row);
  680.     end;
  681.   for Counter := Row to BottomRow do
  682.     DisplayRow(Counter, NOUPDATE);
  683.   LastRow := MAXROWS; SetLastRow; Changed := True; Recalc;
  684. end;
  685.  
  686. procedure SMenu;
  687. var
  688.   FileName : IString;
  689.   X : Word;
  690. begin
  691.   FileName := '';
  692.   case GetCommand(SMNU, SCOMMAND) of
  693.     1 : begin
  694.           CheckForSave;
  695.           LoadSheet(FileName);
  696.         end;
  697.     2 : SaveSheet;
  698.     3 : PrintSheet;
  699.     4 : begin
  700.           CheckForSave;
  701.           ClearSheet;
  702.         end;
  703.   end; { case }
  704. end;
  705.  
  706. procedure CMenu;
  707. begin
  708.   case GetCommand(CMNU, CCOMMAND) of
  709.     1 : InsertCol(CurCol);
  710.     2 : DeleteCol(CurCol);
  711.     3 : SetColWidth(CurCol);
  712.   end; { case }
  713. end;
  714.  
  715. procedure RMenu;
  716. begin
  717.   case GetCommand(RMNU, RCOMMAND) of
  718.     1 : InsertRow(CurRow);
  719.     2 : DeleteRow(CurRow);
  720.   end; { case }
  721. end;
  722.  
  723. procedure UMenu;
  724. begin
  725.   case GetCommand(UMenuString, UCommandString) of
  726.     1 : Recalc;
  727.     2 : begin
  728.       ChangeFormDisplay(not FormDisplay);
  729.       DisplayScreen(UPDATE);
  730.     end;
  731.     3 : begin
  732.       if ScreenRows = 38 then
  733.       begin
  734.         ScreenRows := 20;
  735.         TextMode(Lo(LastMode));
  736.         SetCursor(NoCursor);
  737.         RedrawScreen;
  738.       end
  739.       else begin
  740.         TextMode(Lo(LastMode) + Font8x8);
  741.         if (LastMode and Font8x8) <> 0 then
  742.         begin
  743.           ScreenRows := 38;
  744.           SetCursor(NoCursor);
  745.           RedrawScreen;
  746.         end;
  747.       end;
  748.     end;
  749.   end; { case }
  750. end; { UMenu }
  751.  
  752. procedure MainMenu;
  753. begin
  754.   case GetCommand(MNU, COMMAND) of
  755.     1 : SMenu;
  756.     2 : FormatCells;
  757.     3 : begin
  758.       DeleteCell(CurCol, CurRow, UPDATE);
  759.       PrintFreeMem;
  760.       if AutoCalc then
  761.         Recalc;
  762.     end;
  763.     4 : GotoCell;
  764.     5 : CMenu;
  765.     6 : RMenu;
  766.     7 : EditCell(CurCell);
  767.     8 : UMenu;
  768.     9 : ChangeAutoCalc(not AutoCalc);
  769.     10 : begin
  770.            CheckForSave;
  771.            Stop := True;
  772.          end;
  773.   end; { case }
  774.   GotoXY(1, ScreenRows + 4);
  775.   ClrEol;
  776. end;
  777.  
  778. begin   { keine Initialisierungen }
  779. end.
  780.