DataMuseum.dk

top - metrics - download

    Length: 9950 (0x26de)
    Types: TextFile
    Names: »MCUTIL.PAS«

└─⟦505fbc898⟧ Bits:30002732 Turbo Pascal 5.0 for C-DOS Partner
    └─⟦this⟧ »MCALC\MCUTIL.PAS« 

TextFile

æ Copyright (c) 1985, 88 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.
«eof»