Liren Large Software Subsidy 9/09.iso/l/l043/3.ddi/MCUTIL.PAS

Pascal/Delphi Source File | 1987-11-02 | 9.7 KB | 417 lines

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

unit MCUTIL;

interface

uses Crt, Dos, MCVars;

function Pad(S : String; Len : Word) : String;
{ Pads a string on the right with spaces to a specified length }

function Spaces(Num : Word) : String;
{ Returns a string of the specified number of spaces }

function UpperCase(S : String) : String;
{ Returns a string of all upper case letters }

function WordToString(Num, Len : Word) : String;
{ Changes a word to a string }

function RealToString(Num : Real; Len, Places : Word) : String;
{ Changes a real to a string }

function AllocText(Col, Row : Word; S : String) : Boolean;
{ Allocates space for a text cell }

function AllocValue(Col, Row : Word; Amt : Real) : Boolean;
{ Allocates space for a value cell }

function AllocFormula(Col, Row : Word; S : String; Amt : Real) : Boolean;
{ Allocates space for a formula cell }

function RowWidth(Row : Word) : Word;
{ Returns the width in spaces of row }

function FormulaStart(Input : String; Place : Word;
                      var Col, Row, FormLen : Word) : Boolean;
{ Returns TRUE if the string is the start of a formula, FALSE otherwise.
   Also returns the column, row, and length of the formula.
}

function ColString(Col : Word) : String;
{ Changes a column number to a string }

function CenterColString(Col : Word) : String;
{ Changes a column to a centered string }

function TextString(InString : String; Col, FValue : Word;
                    Formatting : Boolean) : String;
{ Sets the string representation of text }

function ValueString(CPtr : CellPtr; Value : Real; Col, FValue : Word;
                     var Color : Word; Formatting : Boolean) : String;
{ Sets the string representation of a value }

function CellString(Col, Row : Word; var Color : Word;
                    Formatting : Boolean) : String;
{ Creates an output string for the data in the cell in (col, row), and
   also returns the color of the cell }

procedure Switch(var Val1, Val2 : Word);
{ Swaps the first and second values }

procedure InitVars;
{ Initializes various global variables }

function Exists(FileName : String) : Boolean;
{ Returns True if the file FileName exists, False otherwise }

implementation

{$F+}

function HeapFunc(Size : Word) : Word;
{ Used to handle heap errors }
begin
  HeapFunc := 1;       { Forces New or GetMem to return a nil pointer }
end; { HeapFunc }

{$F-}

function Pad;
begin
  if Length(S) < Len then
    FillChar(S[Succ(Length(S))], Len - Length(S), ' ');
  S[0] := Chr(Len);
  Pad := S;
end; { Pad }

function Spaces;
var
  S : String;
begin
  S[0] := Chr(Num);
  FillChar(S[1], Num, ' ');
  Spaces := S;
end; { Spaces }

function UpperCase;
var
  Counter : Word;
begin
  for Counter := 1 to Length(S) do
    S[Counter] := UpCase(S[Counter]);
  UpperCase := S;
end; { UpperCase }

function WordToString;
var
  S : String[5];
begin
  Str(Num:Len, S);
  WordToString := S;
end; { WordToString }

function RealToString;
var
  S : String[80];
begin
  Str(Num:Len:Places, S);
  RealToString := S;
end; { RealToString }

function AllocText;
var
  CPtr : CellPtr;
begin
  AllocText := False;
  GetMem(CPtr, Length(S) + 3);
  if CPtr = nil then
    Exit;
  CPtr^.Attrib := TXT;
  CPtr^.Error := False;
  CPtr^.T := S;
  Cell[Col, Row] := CPtr;
  AllocText := True;
end; { AllocText }

function AllocValue;
var
  CPtr : CellPtr;
begin
  AllocValue := False;
  GetMem(CPtr, SizeOf(Real) + 2);
  if CPtr = nil then
    Exit;
  CPtr^.Attrib := VALUE;
  CPtr^.Error := False;
  CPtr^.Value := Amt;
  Cell[Col, Row] := CPtr;
  AllocValue := True;
end; { AllocValue }

function AllocFormula;
var
  CPtr : CellPtr;
begin
  AllocFormula := False;
  GetMem(CPtr, Length(S) + SizeOf(Real) + 3);
  if CPtr = nil then
    Exit;
  CPtr^.Attrib := FORMULA;
  CPtr^.Error := False;
  CPtr^.Formula := S;
  CPtr^.FValue := Amt;
  Cell[Col, Row] := CPtr;
  AllocFormula := True;
end; { AllocFormula }

function RowWidth;
begin
  RowWidth := Succ(Trunc(Ln(Row) / Ln(10)));
end; { RowWidth }

function FormulaStart;
var
  OldPlace, Len, MaxLen : Word;
  Start : IString;
  NumString : String[10];
begin
  FormulaStart := False;
  OldPlace := Place;
  MaxLen := RowWidth(MAXROWS);
  if not (Input[Place] in LETTERS) then
    Exit;
  Col := Succ(Ord(Input[Place]) - Ord('A'));
  Inc(Place);
  if Input[Place] in LETTERS then
  begin
    Col := Col * 26;
    Col := Succ(Col + Ord(Input[Place]) - Ord('A'));
    Inc(Place);
  end;
  if Col > MAXCOLS then
    Exit;
  Start := Copy(Input, Place, MaxLen);
  Len := 0;
  while (Place <= Length(Input)) and
        (Input[Place] in ['0'..'9']) and (Len < MaxLen) do
  begin
    Inc(Len);
    Inc(Place);
  end;
  if Len = 0 then
    Exit;
  NumString := Copy(Start, 1, Len);
  Val(NumString, Row, Len);
  if Row > MAXROWS then
    Exit;
  FormLen := Place - OldPlace;
  FormulaStart := True;
end; { FormulaStart }

function ColString;
begin
  if Col <= 26 then
    ColString := Chr(Pred(Col) + Ord('A'))
  else
    ColString := Chr((Pred(Col) div 26) + Pred(Ord('A'))) +
              Chr((Pred(Col) mod 26) + Ord('A'));
end; { ColString }

function CenterColString;
var
  S : String[2];
  Spaces1, Spaces2 : Word;
begin
  S := ColString(Col);
  Spaces1 := (ColWidth[Col] - Length(S)) shr 1;
  Spaces2 := ColWidth[Col] - Length(S) - Spaces1;
  CenterColString := Spaces(Spaces1) + S + Spaces(Spaces2);
end; { CenterColString }

function TextString;
var
  OutString : String[80];
begin
  if ((FValue and RJUSTIFY) <> 0) and Formatting then
  begin
    OutString := InString;
    if Length(OutString) < ColWidth[Col] then
    begin
      while Length(OutString) < ColWidth[Col] do
        OutString := ' ' + OutString;
    end
    else
      OutString[0] := Chr(ColWidth[Col]);
  end
  else begin
    if Formatting then
      OutString := Pad(InString, ColWidth[Col])
    else
      OutString := InString;
  end;
  TextString := OutString;
end; { TextString }

function ValueString;
var
  VString : String[MAXCOLWIDTH];
  FString : String[3];
  Width, P : Word;
begin
  if Formatting then
  begin
    Str(CPtr^.Value:1:(FValue and 15), VString);
    if (FValue and COMMAS) <> 0 then
    begin
      P := Pos('.', VString);
      if P = 0 then
        P := Succ(Length(VString));
      while P > 4 do
      begin
        P := P - 3;
        if VString[Pred(P)] <> '-' then
          Insert(',', VString, P);
      end;
    end;
    if (FValue and DOLLAR) <> 0 then
    begin
      if VString[1] = '-' then
      begin
        FString := ' $';
        Width := ColWidth[Col] - 2;
      end
      else begin
        FString := ' $ ';
        Width := ColWidth[Col] - 3;
      end;
    end
    else begin
      Width := ColWidth[Col];
      FString := '';
    end;
    if (FValue and RJUSTIFY) <> 0 then
    begin
      if Length(VString) > Width then
        Delete(VString, Succ(Width), Length(VString) - Width)
      else begin
        while Length(VString) < Width do
          VString := ' ' + VString;
      end;
    end
    else
      VString := Pad(VString, Width);
    VString := FString + VString;
  end
  else
    Str(Value:1:MAXPLACES, VString);
  Color := VALUECOLOR;
  ValueString := VString;
end; { ValueString }

function CellString;
var
  CPtr : CellPtr;
  OldCol, P, NewCol, FormatValue : Word;
  S : String[80];
  V : Real;
begin
  CPtr := Cell[Col, Row];
  if CPtr = nil then
  begin
    if (not Formatting) or (Format[Col, Row] < OVERWRITE) then
    begin
      S := Spaces(ColWidth[Col]);
      Color := BLANKCOLOR;
    end
    else begin
      NewCol := Col;
      Dec(NewCol);
      while Cell[NewCol, Row] = nil do
        Dec(NewCol);
      OldCol := NewCol;
      P := 1;
      while (NewCol < Col) do
      begin
        Inc(P, ColWidth[NewCol]);
        Inc(NewCol);
      end;
      S := Copy(Cell[OldCol, Row]^.T, P, ColWidth[Col]);
      S := S + Spaces(ColWidth[Col] - Length(S));
      Color := TXTCOLOR;
    end;
  end
  else begin
    FormatValue := Format[Col, Row];
    if CPtr^.Error and (Formatting or (CPtr^.Attrib = VALUE)) then
    begin
      S := Pad(MSGERRORTXT, ColWidth[Col]);
      Color := ERRORCOLOR;
    end
    else begin
      case CPtr^.Attrib of
        TXT : begin
          S := TextString(CPtr^.T, Col, FormatValue, Formatting);
          Color := TXTCOLOR;
        end;
        FORMULA : begin
          if FormDisplay then
          begin
            S := TextString(CPtr^.Formula, Col, FormatValue, Formatting);
            Color := FORMULACOLOR;
          end
          else begin
            V := CPtr^.FValue;
            S := ValueString(CPtr, V, Col, FormatValue, Color, Formatting);
          end;
        end;
        VALUE : begin
          V := CPtr^.Value;
          S := ValueString(CPtr, V, Col, FormatValue, Color, Formatting);
        end;
      end; { case }
    end;
  end;
  CellString := S;
end; { CellString }

procedure Switch;
var
  Temp : Word;
begin
  Temp := Val1;
  Val1 := Val2;
  Val2 := Temp;
end; { Switch }

procedure InitVars;
begin
  LeftCol := 1;
  TopRow := 1;
  CurCol := 1;
  Currow := 1;
  LastCol := 1;
  LastRow := 1;
  AutoCalc := True;
  FormDisplay := False;
  FillChar(ColWidth, SizeOf(ColWidth), DEFAULTWIDTH);
  FillChar(Cell, SizeOf(Cell), 0);
  FillChar(Format, SizeOf(Format), DEFAULTFORMAT);
end; { InitVars }

function Exists;
var
  SR : SearchRec;
begin
  FindFirst(FileName, ReadOnly + Hidden + SysFile, SR);
  Exists := (DosError = 0) and (Pos('?', FileName) = 0) and
            (Pos('*', FileName) = 0);
end; { Exists }

begin
  HeapError := @HeapFunc;
end.