⟦ccb9ed919⟧

TextFile


æ Copyright (c) 1985, 88 by Borland International, Inc. å

unit MCLIB;

interface

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

procedure DisplayCell(Col, Row : Word; Highlighting, Updating : Boolean);
æ Displays the contents of a cell å

function SetOFlags(Col, Row : Word; Display : Boolean) : Word;
æ Sets the overwrite flag on cells starting at (col + 1, row) - returns
   the number of the column after the last column set.
å

procedure ClearOFlags(Col, Row : Word; Display : Boolean);
æ Clears the overwrite flag on cells starting at (col, row) å

procedure UpdateOFlags(Col, Row : Word; Display : Boolean);
æ Starting in col, moves back to the last TEXT cell and updates all flags å

procedure DeleteCell(Col, Row : Word; Display : Boolean);
æ Deletes a cell å

procedure SetLeftCol;
æ Sets the value of LeftCol based on the value of RightCol å

procedure SetRightCol;
æ Sets the value of rightcol based on the value of leftcol å

procedure SetTopRow;
æ Figures out the value of toprow based on the value of bottomrow å

procedure SetBottomRow;
æ Figures out the value of bottomrow based on the value of toprow å

procedure SetLastCol;
æ Sets the value of lastcol based on the current value å

procedure SetLastRow;
æ Sets the value of lastrow based on the current value å

procedure ClearLastCol;
æ Clears any data left in the last column å

procedure DisplayCol(Col : Word; Updating : Boolean);
æ Displays a column on the screen å

procedure DisplayRow(Row : Word; Updating : Boolean);
æ Displays a row on the screen å

procedure DisplayScreen(Updating : Boolean);
æ Displays the current screen of the spreadsheet å

procedure RedrawScreen;
æ Displays the entire screen å

procedure FixFormula(Col, Row, Action, Place : Word);
æ Modifies a formula when its column or row designations need to change å

procedure ChangeAutoCalc(NewMode : Boolean);
æ Changes and prints the current AutoCalc value on the screen å

procedure ChangeFormDisplay(NewMode : Boolean);
æ Changes and prints the current formula display value on the screen å

procedure Recalc;
æ Recalculates all of the numbers in the speadsheet å

procedure Act(S : String);
æ Acts on a particular input å

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; æ DisplayCell å

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; æ SetOFlags å

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; æ ClearOFlags å

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

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; æ DeleteCell å

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
  begin
    for Col := LeftCol to RightCol do
      Dec(ColStartÆSucc(Col - LeftCol)Å, Total);
  end;
  PrintCol;
end; æ SetLeftCol å

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

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

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

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

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

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; æ ClearLastCol å

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

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

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

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; æ RedrawScreen å

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 : begin
          if FCol >= Place then
          begin
            if FCol = 26 then
            begin
              if Length(NewFormula) = MAXINPUT then
              begin
                DeleteCell(Col, Row, NOUPDATE);
                Good := AllocText(Col, Row, NewFormula);
                Exit;
              end;
            end;
            S := ColString(FCol);
            Delete(NewFormula, ColStart, Length(S));
            S := ColString(Succ(FCol));
            Insert(S, NewFormula, ColStart);
          end;
        end;
        ROWADD : begin
          if FRow >= Place then
          begin
            if RowWidth(Succ(FRow)) <> RowWidth(FRow) then
            begin
              if Length(NewFormula) = MAXINPUT then
              begin
                DeleteCell(Col, Row, NOUPDATE);
                Good := AllocText(Col, Row, NewFormula);
                Exit;
              end;
            end;
            S := WordToString(FRow, 1);
            Delete(NewFormula, RowStart, Length(S));
            S := WordToString(Succ(FRow), 1);
            Insert(S, NewFormula, RowStart);
          end;
        end;
        COLDEL : begin
          if FCol > Place then
          begin
            S := ColString(FCol);
            Delete(NewFormula, ColStart, Length(S));
            S := ColString(Pred(FCol));
            Insert(S, NewFormula, ColStart);
          end;
        end;
        ROWDEL : begin
          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;
      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; æ FixFormula å

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; æ ChangeAutoCalc å

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; æ ChangeFormDisplay å

procedure Recalc;
var
  Col, Row, Attrib : Word;
begin
  for Col := 1 to LastCol do
  begin
    for Row := 1 to LastRow do
    begin
      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;
    end;
  end;
  DisplayScreen(UPDATE);
end; æ Recalc å

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; æ Act å

end.
«eof»
DataMuseum.dk

CP/M

⟦ccb9ed919⟧ TextFile

Derivation

TextFile
