Turbo Toolbox/Turbo_Toolbox.iso/turbo4/mclib.pas

Pascal/Delphi Source File | 1987-12-08 | 12KB | 433 lines

{           Copyright (c) 1985, 87 by Borland International, Inc.            }

unit MCLIB;

interface

uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser;

procedure DisplayCell(Col, Row : Word; Highlighting, Updating : Boolean);
{ gibt den Inhalt einer Zelle aus }

function SetOFlags(Col, Row : Word; Display : Boolean) : Word;
{ setzt das Flag "Overwrite" ab (col+1, row) und liefert die Nummer der
  Spalte rechts neben der zuletzt gesetzten Spalte zurück }
procedure ClearOFlags(Col, Row : Word; Display : Boolean);
{ löscht das Flag "Overwrite" ab (col, row) }

procedure UpdateOFlags(Col, Row : Word; Display : Boolean);
{ sucht ab col rückwärts nach der letzten TEXT-Zelle und bringt alle
  Flags auf den neuesten Stand }

procedure DeleteCell(Col, Row : Word; Display : Boolean);
{ löscht eine Zelle }

procedure SetLeftCol;   { setzt den Wert von LeftCol abhängig von RightCol }
procedure SetRightCol;  { setzt den Wert von RightCol abhängig von LeftCol }
procedure SetTopRow;    { setzt TopRow abhängig von BottomRow }
procedure SetBottomRow; { setzt BottomRow abhängig von TopRow }
procedure SetLastCol;   { sucht die rechteste belegte Spalte }
procedure SetLastRow;   { sucht die unterste belegte Zeile }

procedure ClearLastCol;  { löscht Daten in der rechtesten Spalte }

procedure DisplayCol(Col : Word; Updating : Boolean);
{ stellt eine Spalte auf dem Bildschirm dar }
procedure DisplayRow(Row : Word; Updating : Boolean);
{ stellt eine Zeile auf dem Bildschirm dar }
procedure DisplayScreen(Updating : Boolean);
{ stellt den aktuellen Ausschnitt des Rechenblattes auf dem Bildschirm dar }

procedure RedrawScreen;  { akualisiert den gesamten Bildschirm }

procedure FixFormula(Col, Row, Action, Place : Word);
{ paßt eine Formel nach Löschen/Einfügen von Zeilen/Spalten an }

procedure ChangeAutoCalc(NewMode : Boolean);
{ schaltet zwischen "Manuell" und "AutoCalc" um }

procedure ChangeFormDisplay(NewMode : Boolean);
{ schaltet zwischen "Ergebnisse" und "Formel-Darstellung" um }

procedure Recalc;
{ rechnet alle Zellen des Rechenblattes neu durch }

procedure Act(S : String);  { interpretiert Eingaben }

{***************************************************************}
{***************************************************************}
implementation

procedure DisplayCell;
var
  Color : Word;
  S : IString;
begin
  if Updating and
      ((Cell[Col, Row] = Nil) or (Cell[Col, Row]^.Attrib <> FORMULA)) then
    Exit;
  S := CellString(Col, Row, Color, DOFORMAT);
  if Highlighting then
  begin
    if Color = ERRORCOLOR then Color := HIGHLIGHTERRORCOLOR
     else Color := HIGHLIGHTCOLOR;
  end;
  SetColor(Color);
  WriteXY(S, ColStart[Succ(Col - LeftCol)], Row - TopRow + 3);
end;

function SetOFlags;
var
  Len : Integer;
begin
  Len := Length(Cell[Col, Row]^.T) - ColWidth[Col];
  Inc(Col);
  while (Col <= MAXCOLS) and (Len > 0) and (Cell[Col, Row] = nil) do
  begin
    Format[Col, Row] := Format[Col, Row] or OVERWRITE;
    Dec(Len, ColWidth[Col]);
    if Display and (Col >= LeftCol) and (Col <= RightCol) then
      DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
    Inc(Col);
  end;
  SetOFlags := Col;
end;

procedure ClearOFlags;
begin
  while (Col <= MAXCOLS) and (Format[Col, Row] >= OVERWRITE) and
        (Cell[Col, Row] = nil) do
  begin
    Format[Col, Row] := Format[Col, Row] and (not OVERWRITE);
    if Display and (Col >= LeftCol) and (Col <= RightCol) then
      DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
    Inc(Col);
  end;
end;

procedure UpdateOFlags;
var
  Dummy : Word;
begin
  while (Cell[Col, Row] = nil) and (Col > 1) do
    Dec(Col);
  if (Cell[Col, Row]^.Attrib = TXT) and (Col >= 1) then
    Dummy := SetOFlags(Col, Row, Display);
end;

procedure DeleteCell;
var
  CPtr : CellPtr;
  Size : Word;
begin
  CPtr := Cell[Col, Row];
  if CPtr = nil then Exit;
  case CPtr^.Attrib of
    TXT : begin
      Size := Length(CPtr^.T) + 3;
      ClearOFlags(Succ(Col), Row, Display);
    end;
    VALUE : Size := SizeOf(Real) + 2;
    FORMULA : Size := SizeOf(Real) + Length(CPtr^.Formula) + 3;
  end; { case }
  Format[Col, Row] := Format[Col, Row] and (not OVERWRITE);
  FreeMem(CPtr, Size);
  Cell[Col, Row] := nil;
  if Col = LastCol then SetLastCol;
  if Row = LastRow then SetLastRow;
  UpdateOFlags(Col, Row, Display);
  Changed := True;
end;

procedure SetLeftCol;
var
  Col : Word;
  Total : Integer;
begin
  Total := 81;
  Col := 0;
  while (Total > LEFTMARGIN) and (RightCol - Col > 0) do
  begin
    Dec(Total, ColWidth[RightCol - Col]);
    if Total > LEFTMARGIN then ColStart[SCREENCOLS - Col] := Total;
    Inc(Col);
  end;
  if Total > LEFTMARGIN then Inc(Col);
  Move(ColStart[SCREENCOLS - Col + 2], ColStart, Pred(Col));
  LeftCol := RightCol - Col + 2;
  Total := Pred(ColStart[1] - LEFTMARGIN);
  if Total <> 0 then
    for Col := LeftCol to RightCol do
      Dec(ColStart[Succ(Col - LeftCol)], Total);
  PrintCol;
end;

procedure SetRightCol;
var
  Total, Col : Word;
begin
  Total := Succ(LEFTMARGIN);
  Col := 1;
  repeat
    ColStart[Col] := Total;
    Inc(Total, ColWidth[Pred(LeftCol + Col)]);
    Inc(Col);
  until (Total > 81) or (Pred(LeftCol + Col) > MAXCOLS);
  if Total > 81 then Dec(Col);
  RightCol := LeftCol + Col - 2;
  PrintCol;
end;

procedure SetTopRow;
begin
  if BottomRow < ScreenRows then BottomRow := ScreenRows;
  TopRow := Succ(BottomRow - ScreenRows);
  PrintRow;
end;

procedure SetBottomRow;
begin
  if TopRow + ScreenRows > Succ(MAXROWS) then
    TopRow := Succ(MAXROWS - ScreenRows);
  BottomRow := Pred(TopRow + ScreenRows);
  PrintRow;
end;

procedure SetLastCol;
var
  Row, Col : Word;
begin
  for Col := LastCol downto 1 do
    for Row := 1 to LastRow do
      if Cell[Col, Row] <> nil then
      begin
        LastCol := Col;
        Exit;
      end;
  LastCol := 1;
end;

procedure SetLastRow;
var
  Row, Col : Word;
begin
  for Row := LastRow downto 1 do
    for Col := 1 to LastCol do
      if Cell[Col, Row] <> nil then
      begin
        LastRow := Row;
        Exit;
      end;
  LastRow := 1;
end;

procedure ClearLastCol;
var
  Col : Word;
begin
  Col := ColStart[Succ(RightCol - LeftCol)] + ColWidth[RightCol];
  if (Col < 80) then Scroll(UP, 0, Col, 3, 80, ScreenRows + 2, White);
end;

procedure DisplayCol;
var
  Row : Word;
begin
  for Row := TopRow to BottomRow do
    DisplayCell(Col, Row, NOHIGHLIGHT, Updating);
end;

procedure DisplayRow;
var
  Col : Word;
begin
  for Col := LeftCol to RightCol do
    DisplayCell(Col, Row, NOHIGHLIGHT, Updating);
end;

procedure DisplayScreen;
var
  Row : Word;
begin
  for Row := TopRow to BottomRow do
    DisplayRow(Row, Updating);
  ClearLastCol;
end;

procedure RedrawScreen;
begin
  CurRow := 1; CurCol := 1; LeftCol := 1; TopRow := 1;
  SetRightCol; SetBottomRow;
  GotoXY(1, 1);
  SetColor(MSGMEMORYCOLOR);
  Write(MSGMEMORY);
  GotoXY(29, 1);
  SetColor(PROMPTCOLOR);
  Write(MSGCOMMAND);
  ChangeAutocalc(Autocalc);
  ChangeFormDisplay(FormDisplay);
  PrintFreeMem;
  DisplayScreen(NOUPDATE);
end;

procedure FixFormula;
var
  FormLen, ColStart, RowStart, CurPos, FCol, FRow : Word;
  CPtr : CellPtr;
  Value : Real;
  S : String[5];
  NewFormula : IString;
  Good : Boolean;
begin
  CPtr := Cell[Col, Row];
  CurPos := 1;
  NewFormula := CPtr^.Formula;
  while CurPos < Length(NewFormula) do
  begin
    if FormulaStart(NewFormula, CurPos, FCol, FRow, FormLen) then
    begin
      if FCol > 26 then
      begin
        RowStart := CurPos + 2;
        ColStart := RowStart - 2;
      end
      else begin
        RowStart := Succ(CurPos);
        ColStart := Pred(RowStart);
      end;
      case Action of
       COLADD:  if FCol >= Place then
                begin
                  if FCol = 26 then
                    if Length(NewFormula) = MAXINPUT then
                    begin
                      DeleteCell(Col, Row, NOUPDATE);
                      Good := AllocText(Col, Row, NewFormula);
                      Exit;
                    end;
                  S := ColString(FCol);
                  Delete(NewFormula, ColStart, Length(S));
                  S := ColString(Succ(FCol));
                  Insert(S, NewFormula, ColStart);
                end;
      ROWADD : if FRow >= Place then
               begin
                 if RowWidth(Succ(FRow)) <> RowWidth(FRow) then
                    if Length(NewFormula) = MAXINPUT then
                    begin
                      DeleteCell(Col, Row, NOUPDATE);
                      Good := AllocText(Col, Row, NewFormula);
                      Exit;
                    end;
                 S := WordToString(FRow, 1);
                 Delete(NewFormula, RowStart, Length(S));
                 S := WordToString(Succ(FRow), 1);
                 Insert(S, NewFormula, RowStart);
               end;
      COLDEL : if FCol > Place then
               begin
                 S := ColString(FCol);
                 Delete(NewFormula, ColStart, Length(S));
                 S := ColString(Pred(FCol));
                 Insert(S, NewFormula, ColStart);
               end;
     ROWDEL : if FRow > Place then
              begin
                S := WordToString(FRow, 1);
                Delete(NewFormula, RowStart, Length(S));
                S := WordToString(Pred(FRow), 1);
                Insert(S, NewFormula, RowStart);
              end;
      end; { case }
      Inc(CurPos, FormLen);
    end
    else Inc(CurPos);
  end;
  if Length(NewFormula) <> Length(CPtr^.Formula) then
  begin
    Value := CPtr^.FValue;
    DeleteCell(Col, Row, NOUPDATE);
    Good := AllocFormula(Col, Row, NewFormula, Value);
  end
  else CPtr^.Formula := NewFormula;
end;

procedure ChangeAutoCalc;
var
  S : String[15];
begin
  if (not AutoCalc) and NewMode then Recalc;
  AutoCalc := NewMode;
  if AutoCalc then S := MSGAUTOCALC
  else S := '';
  SetColor(MSGAUTOCALCCOLOR);
  GotoXY(73, 1);
  Write(S:Length(MSGAUTOCALC));
end;

procedure ChangeFormDisplay;
var S: String[15];
begin
  FormDisplay := NewMode;
  if FormDisplay then S := MSGFORMDISPLAY
  else S := '';
  SetColor(MSGFORMDISPLAYCOLOR);
  GotoXY(65, 1);
  Write(S:Length(MSGFORMDISPLAY));
end;

procedure Recalc;
var
  Col, Row, Attrib : Word;
begin
  for Col := 1 to LastCol do
    for Row := 1 to LastRow do
      if ((Cell[Col, Row] <> nil) and (Cell[Col, Row]^.Attrib = FORMULA)) then
      begin
        Cell[Col, Row]^.FValue := Parse(Cell[Col, Row]^.Formula, Attrib);
        Cell[Col, Row]^.Error := Attrib >= 4;
      end;
  DisplayScreen(UPDATE);
end;

procedure Act;
var
  Attrib, Dummy : Word;
  Allocated : Boolean;
  V : Real;
begin
  DeleteCell(CurCol, CurRow, UPDATE);
  V := Parse(S, Attrib);
  case (Attrib and 3) of
    TXT : begin
      Allocated := AllocText(CurCol, CurRow, S);
      if Allocated then
        DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
    end;
    VALUE : Allocated := AllocValue(CurCol, CurRow, V);
    FORMULA : Allocated := AllocFormula(CurCol, CurRow, UpperCase(S), V);
  end; { case }
  if Allocated then
  begin
    if Attrib >= 4 then
    begin
      Cell[CurCol, CurRow]^.Error := True;
      Dec(Attrib, 4);
    end
     else Cell[CurCol, CurRow]^.Error := False;
    Format[CurCol, CurRow] := Format[CurCol, CurRow] and (not OVERWRITE);
    ClearOFlags(Succ(CurCol), CurRow, UPDATE);
    if Attrib = TXT then Dummy := SetOFlags(CurCol, CurRow, UPDATE);
    if CurCol > LastCol then LastCol := CurCol;
    if CurRow > LastRow then LastRow := CurRow;
    if AutoCalc then Recalc;
  end
  else
    ErrorMsg(MSGLOMEM);
  PrintFreeMem;
end;

begin  { keine Initialisierungen }
end.