417 lines
9.7 KiB
Plaintext
417 lines
9.7 KiB
Plaintext
|
||
{ 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.
|
||
|