1582 lines
52 KiB
Plaintext
1582 lines
52 KiB
Plaintext
{*************************************************************************}
|
||
{ MicroCalc Module 000 }
|
||
{ Last Modified : 7-22-85 }
|
||
{ }
|
||
{ Purpose : Miscellaneous utilities and commands. }
|
||
{ }
|
||
{*************************************************************************}
|
||
|
||
procedure Help; forward; { procedure Help is forward declared in the int- }
|
||
{ erest of keeping all miscellaneous routines }
|
||
{ grouped in one module. }
|
||
|
||
|
||
{ procedure Center centers the string passed as the paramater on the }
|
||
{ screen. NOTE : This routine assumes an 80 column screen. }
|
||
|
||
procedure Center(S : AnyString);
|
||
var
|
||
I : Integer;
|
||
begin
|
||
for I := 1 to ((80-Length(S)) div 2) do
|
||
Write(' '); {Fill beginning of line with spaces based on the length(S)}
|
||
writeln(S);
|
||
end; { end Sub-procedure Center }
|
||
|
||
{ procedure Welcome says Welcome and activates the help procedure if the }
|
||
{ user presses any key other than Carriage Return. }
|
||
|
||
procedure Welcome;
|
||
begin { procedure Welcome }
|
||
ClrScr;
|
||
GotoXY(1,9);
|
||
Center('Welcome to MicroCalc. A Turbo Pascal demonstration program');
|
||
Center('Press any key for help or <RETURN> to start');
|
||
GotoXY(40,12);
|
||
Read(Kbd,Ch);
|
||
{ If Ch entered does not equal a carriage return then call Help routine.}
|
||
if Ch <> ^M then Help;
|
||
end; { end procedure Welcome }
|
||
|
||
{ procedure Msg outputs the string, passed in as a paramater, to the }
|
||
{ screen. }
|
||
|
||
procedure Msg(S : AnyString);
|
||
begin
|
||
GotoXY(1,24);
|
||
ClrEol;
|
||
Write(S);
|
||
ClrEol;
|
||
end; { End procedure Msg }
|
||
|
||
{ The procedure Flash causes the string input as a paramater to flash by }
|
||
{ alternately writeing it to the screen in LowVideo and NormVideo. }
|
||
|
||
{ NOTES :
|
||
1. procedure Flash allows you to specify the column in which
|
||
the string will be written. A possible extension of the
|
||
routine could be to allow the user to specify the row also.
|
||
2. By setting the blink paramater to true or false the string
|
||
will flash or not flash. If Blink is true the string will
|
||
Flash until a key is pressed.
|
||
3. Upon exit of the procedure, the string will be written in
|
||
LowVideo regardless of the value of Blink }
|
||
|
||
procedure Flash(X : Integer; S : AnyString; Blink : boolean);
|
||
begin
|
||
NormVideo;
|
||
GotoXY(X,23);
|
||
Write(S);
|
||
if Blink then { Check value of Blink, if true then execute the repeat }
|
||
begin { until loop. }
|
||
repeat
|
||
GotoXY(X,23);
|
||
Blink := not Blink; { By modifying the value of Blink after }
|
||
if Blink then { each iteration of the loop, we can use }
|
||
NormVideo { Blink's value as a test for the appro- }
|
||
else { priate Video attribute value. }
|
||
LowVideo;
|
||
Write(S);
|
||
Delay(175);
|
||
until KeyPressed;
|
||
end;
|
||
LowVideo;
|
||
end; { End procedure Flash }
|
||
|
||
{ procedure IBMCh determines the extended scan code read in and returns }
|
||
{ a one character interpolation of the characters read in. }
|
||
|
||
procedure IBMCh(var Ch: Char);
|
||
begin
|
||
case Ch of
|
||
'H': Ch := ^E;
|
||
'P': Ch := ^X;
|
||
'M': Ch := ^D;
|
||
'K': Ch := ^S;
|
||
'S': Ch := #127;
|
||
'R': Ch := ^V;
|
||
'G', 'I', 'O',
|
||
'Q': Ch := #00;
|
||
end;
|
||
end; { End procedure IBMCh }
|
||
|
||
procedure Auto; { Toggles automatic calculation mode on and off }
|
||
begin
|
||
AutoCalc:=not AutoCalc;
|
||
if AutoCalc then Flash(60,'AutoCalc: ON ',false)
|
||
else Flash(60,'AutoCalc: OFF',false);
|
||
end;
|
||
|
||
{*************************************************************************}
|
||
{ MicroCalc Module 001 }
|
||
{ Last Modified 7-22-85 }
|
||
{ }
|
||
{ Purpose : initialize Spread sheet, redraw screen, and clear current }
|
||
{ spread sheet }
|
||
{ }
|
||
{*************************************************************************}
|
||
|
||
{ procedure Grid Displays the entire spread sheet grid and command line. }
|
||
|
||
procedure Grid;
|
||
var
|
||
I : Integer;
|
||
Count : Char;
|
||
|
||
begin
|
||
NormVideo;
|
||
For Count := 'A' to FXMax do { Display Column Names (A..FXMax) }
|
||
begin
|
||
GotoXY(XPos[Count],1);
|
||
Write(Count);
|
||
end;
|
||
GotoXY(1,2);
|
||
for I := 1 to FYMax do { Display Row numbers (1..FYMax) }
|
||
writeln(I:2);
|
||
LowVideo;
|
||
if AutoCalc then { Display Status line }
|
||
Flash(60,'AutoCalc: ON' ,false)
|
||
else
|
||
Flash(60,'AutoCalc: OFF',false);
|
||
Flash(33,' Type / for Commands',false);
|
||
end; { End procedure Grid }
|
||
|
||
{ procedure Init initializes the values of each of the cells in the grid. }
|
||
{ NOTE : Initializing variables in TURBO PASCAL is very important. }
|
||
|
||
procedure Init;
|
||
var
|
||
I : ColumnName;
|
||
J : Integer;
|
||
LastName : string[2];
|
||
|
||
begin
|
||
for I := 'A' to FXMAX do { Traverse grid Column by Column - Row }
|
||
begin { by Row, initializing each cell }
|
||
for J := 1 to FYMAX do
|
||
begin
|
||
with Sheet[I,J] do { Access record representing this cell }
|
||
begin
|
||
CellStatus := [Txt]; { Default cell attribute }
|
||
Contents := ''; { Value of default cell attribute }
|
||
Value := 0; { Default value of numeric field }
|
||
DEC := 2; { Default number of decimals }
|
||
FW := 10; { Default field width }
|
||
end;
|
||
end;
|
||
end;
|
||
AutoCalc := True; { AutoCalc defaults to True or ON }
|
||
FX:='A'; FY:=1; { Field A1 is default current field }
|
||
end; { End procedure Init }
|
||
|
||
{ procedure Clear clears the current worksheet. }
|
||
|
||
procedure Clear;
|
||
begin
|
||
NormVideo;
|
||
GotoXY(1,24); ClrEol;
|
||
Write('Clear this worksheet? (Y/N) ');
|
||
repeat
|
||
Read(Kbd,Ch)
|
||
until Upcase(Ch) in ['Y','N'];
|
||
Write(Upcase(Ch));
|
||
if UpCase(Ch)='Y' then
|
||
begin
|
||
ClrScr;
|
||
Init;
|
||
Grid;
|
||
end;
|
||
end; { End procedure Clear }
|
||
|
||
{*************************************************************************}
|
||
{ MicroCalc Module 002 }
|
||
{ Last Modified 7-22-85 }
|
||
{ }
|
||
{ Purpose : Cursor movement whithin the spread sheet }
|
||
{ }
|
||
{*************************************************************************}
|
||
|
||
{ procedure DisplayType outputs the current cell it's type and if the }
|
||
{ cell's type is a formula the formula is also output. }
|
||
|
||
procedure DisplayType;
|
||
begin
|
||
with Sheet[FX,FY] do
|
||
begin
|
||
GotoXY(1,23);
|
||
Write(FX,FY:2,' ');
|
||
if Formula in CellStatus then { Determine Type of Cell }
|
||
write('Formula ')
|
||
else
|
||
if Constant in CellStatus then
|
||
Write('Numeric ')
|
||
else
|
||
if Txt in CellStatus then
|
||
Write('Text ');
|
||
GotoXY(1,24); ClrEol;
|
||
if Formula in CellStatus
|
||
then Write(Contents);
|
||
end;
|
||
end; { End procedure DisplayType }
|
||
|
||
{*************************************************************************}
|
||
{ The following procedures move between the Cells on the calc sheet. Each }
|
||
{ Cell has an associated record containing its X,Y coordinates and data. }
|
||
{ See the type definition for "Cell". }
|
||
{*************************************************************************}
|
||
|
||
{ procedure GotoCell goes to the cell indicated by the procedures }
|
||
{ paramaters and outputs it's current value. }
|
||
|
||
procedure GotoCell(GX: ColumnName; GY: Integer);
|
||
begin
|
||
with Sheet[GX,GY] do { Get specified record (i.e. cell) }
|
||
begin
|
||
NormVideo;
|
||
GotoXY(XPos[GX],GY+1); { Go to leftmost column of specified cell }
|
||
Write(' '); { Clear the cell }
|
||
GotoXY(XPos[GX],GY+1);
|
||
if Txt in CellStatus then
|
||
Write(Contents)
|
||
else { cell does not contain text }
|
||
begin
|
||
if DEC >= 0 then { check if number of decimal spaces is }
|
||
Write(Value:FW:DEC) { specified else output in scientific }
|
||
else { notation. }
|
||
Write(Value:FW);
|
||
end;
|
||
DisplayType;
|
||
GotoXY(XPos[GX],GY+1);
|
||
end;
|
||
LowVideo;
|
||
end;
|
||
|
||
{ procedure LeaveCell simply writes the current cell's contents in }
|
||
{ LowVideo. }
|
||
|
||
procedure LeaveCell(FX : ColumnName; FY : Integer);
|
||
begin
|
||
with Sheet[FX,FY] do { Get record representing current cell }
|
||
begin
|
||
GotoXY(XPos[FX],FY + 1);
|
||
LowVideo;
|
||
if Txt in CellStatus then
|
||
Write(Contents)
|
||
else
|
||
begin
|
||
if DEC >= 0 then
|
||
Write(Value:FW:DEC)
|
||
else
|
||
Write(Value:FW);
|
||
end;
|
||
end;
|
||
end; { End procedure LeaveCell }
|
||
|
||
procedure Update;
|
||
var
|
||
UFX : ColumnName;
|
||
UFY : Integer;
|
||
|
||
begin
|
||
ClrScr;
|
||
Grid;
|
||
for UFX := 'A' to FXMax do
|
||
for UFY := 1 to FYMax do
|
||
if Sheet[UFX,UFY].Contents <> '' then
|
||
LeaveCell(UFX,UFY);
|
||
GotoCell(FX,FY);
|
||
end;
|
||
|
||
{ procedure MoveDown updates the current cell by calling procedure }
|
||
{ LeaveCell. It then moves the cursor down on position. Note : The repeat }
|
||
{ loop in this routine does the actuall moving of the cursor. A valid cell}
|
||
{ must be found before the cursor can be moved. The cell is valid if it's }
|
||
{ CellStatus is not in [OverWritten,Locked] . }
|
||
|
||
procedure MoveDown;
|
||
var
|
||
Start : Integer;
|
||
|
||
begin
|
||
LeaveCell(FX,FY);
|
||
Start := FY;
|
||
repeat
|
||
FY := FY + 1;
|
||
if FY > FYMax then
|
||
FY := 1;
|
||
until (Sheet[FX,FY].CellStatus * [OverWritten,Locked] = []) or (FY = Start);
|
||
if FY <> Start then
|
||
GotoCell(FX,FY);
|
||
end; { End procedure MoveDown }
|
||
|
||
{ procedure MoveUp updates the current cell, then moves the cursor up one }
|
||
{ position. The note for the last procedure applies here also. }
|
||
|
||
procedure MoveUp;
|
||
var
|
||
Start : Integer;
|
||
|
||
begin
|
||
LeaveCell(FX,FY);
|
||
Start := FY;
|
||
repeat
|
||
FY := FY - 1;
|
||
if FY < 1 then
|
||
FY := FYMax;
|
||
until (Sheet[FX,FY].CellStatus * [OverWritten,Locked] = []) or (FY = Start);
|
||
if FY <> Start then
|
||
GotoCell(FX,FY);
|
||
end; { End procedure MoveUp }
|
||
|
||
{ procedure MoveRight acts the same as the previous two procedures with }
|
||
{ the exception of the direction it moves the cursor. }
|
||
|
||
procedure MoveRight;
|
||
var
|
||
Start : ColumnName;
|
||
|
||
begin
|
||
LeaveCell(FX,FY);
|
||
Start := FX;
|
||
repeat
|
||
FX := Succ(FX);
|
||
if FX > FXMax then
|
||
begin
|
||
FX := 'A';
|
||
FY := FY + 1;
|
||
if FY > FYMax then
|
||
FY := 1;
|
||
end;
|
||
until (Sheet[FX,FY].CellStatus * [OverWritten,Locked] = []) or (FX = Start);
|
||
if FX <> Start then
|
||
GotoCell(FX,FY);
|
||
end; { End procedure MoveRight }
|
||
|
||
{ procedure MoveLeft acts the same as the previous three procedures with }
|
||
{ the exception of the direction it moves the cursor. }
|
||
|
||
procedure MoveLeft;
|
||
var
|
||
Start : ColumnName;
|
||
|
||
begin
|
||
LeaveCell(FX,FY);
|
||
Start := FX;
|
||
repeat
|
||
FX := Pred(FX);
|
||
if FX < 'A' then
|
||
begin
|
||
FX := FXMax;
|
||
FY := FY - 1;
|
||
if FY < 1 then
|
||
FY := FYMax;
|
||
end;
|
||
until (Sheet[FX,FY].CellStatus * [OverWritten,Locked] = []) or (FX = Start);
|
||
if FX <> Start then
|
||
GotoCell(FX,FY);
|
||
end; { End procedure MoveLeft }
|
||
|
||
{*************************************************************************}
|
||
{ MicroCalc Module 003 }
|
||
{ Last Modified : 7-22-85 }
|
||
{ }
|
||
{ PURPOSE: Load, Save and Print a spread sheet. }
|
||
{ Display on-line manual. }
|
||
{*************************************************************************}
|
||
|
||
{ function Exist returns a boolean value indicating the existence of
|
||
the file passed in as a paramater. }
|
||
|
||
function Exist(FileN : AnyString): boolean;
|
||
|
||
var
|
||
F : file;
|
||
|
||
begin
|
||
{$I-}
|
||
assign(F,FileN);
|
||
reset(F);
|
||
{$I+}
|
||
if IOResult <> 0 then
|
||
Exist := false
|
||
else
|
||
begin
|
||
Exist := true;
|
||
close(F);
|
||
end;
|
||
end; { End function Exist }
|
||
|
||
|
||
{ Procedure GetFileName reads a filename input by the user. The
|
||
filename's extension is passed in as the second paramater of the
|
||
procedure.
|
||
Note : As the procedure stands, the user can not use path names. }
|
||
|
||
Procedure GetFileName(var Line : AnyString; FileType : String3);
|
||
|
||
var
|
||
i : Integer;
|
||
|
||
begin
|
||
Line := '';
|
||
Read(Line);
|
||
clreol;
|
||
if Length(Line) > 8 then
|
||
begin
|
||
clreol;
|
||
Line[0] := chr(8);
|
||
Msg('Filename Truncated to : ' + Line);
|
||
end;
|
||
for i := 1 to Length(Line) do
|
||
begin
|
||
Line[i] := UpCase(Line[i]);
|
||
if not (Line[i] in ['A'..'Z','0'..'9'
|
||
(*,'!','#'..')','-',',','/','@','\','_','`','{','}'*)
|
||
]) then
|
||
Msg('Invalid Filename');
|
||
end;
|
||
if Line <> '' then
|
||
Line := Line + '.' + FileType;
|
||
end; { End Procedure GetFileName }
|
||
|
||
|
||
|
||
|
||
{ Procedure Save saves the current spreadsheet to a file.
|
||
Note : this routine attaches the extension 'MCS' to the filename. }
|
||
|
||
Procedure Save;
|
||
|
||
var
|
||
I : ColumnName;
|
||
J : Integer;
|
||
|
||
begin
|
||
NormVideo;
|
||
Msg('Save: Enter filename ');
|
||
GetFileName(Filename,'MCS');
|
||
if FileName <> '' then
|
||
begin
|
||
Assign(MCFile,FileName);
|
||
Rewrite(MCFile);
|
||
for I := 'A' to FXmax do
|
||
for J := 1 to FYmax do
|
||
write(MCfile,Sheet[I,J]);
|
||
Grid;
|
||
Close(MCFile);
|
||
LowVideo;
|
||
GotoCell(FX,FY);
|
||
end;
|
||
end; { End Procedure Save }
|
||
|
||
|
||
|
||
{ Procedure Load loads a spreadsheet from a file.
|
||
Note : the procedure gives the user two chances to enter the
|
||
correct filename. }
|
||
|
||
Procedure Load;
|
||
|
||
begin
|
||
NormVideo;
|
||
Msg('Load: Enter filename ');
|
||
GetFileName(Filename,'MCS'); { Get filename }
|
||
if (Filename <> '') then { Check if filename is legal }
|
||
if (not exist(FileName)) then { if filename not legal then }
|
||
repeat { prompt the user again. }
|
||
Msg('File not Found: Enter another filename ');
|
||
GetFileName(Filename,'MCS');
|
||
until exist(FileName) or (FileName = '');
|
||
if FileName <> '' then
|
||
begin
|
||
ClrScr;
|
||
Msg('Please Wait. Loading definition...');
|
||
Assign(MCFile,FileName);
|
||
Reset(MCFile);
|
||
for FX := 'A' to FXmax do { Read records from file }
|
||
for FY := 1 to FYmax do
|
||
read(MCFile,Sheet[FX,FY]);
|
||
FX := 'A';
|
||
FY := 1;
|
||
LowVideo;
|
||
UpDate;
|
||
end;
|
||
GotoCell(FX,FY);
|
||
end; { End Procedure Load }
|
||
|
||
|
||
|
||
{ Procedure Print prints the current spreadsheet to a file.
|
||
Note : a possible improvement might be to allow the user to specify
|
||
not only the left margin of the paper, but also the width
|
||
of the paper. Also allowing output to go directly to the
|
||
printer. }
|
||
|
||
Procedure Print;
|
||
|
||
var
|
||
I : ColumnName;
|
||
J, Count,
|
||
LeftMargin : Integer;
|
||
P : string[20];
|
||
MCFile : Text;
|
||
|
||
begin
|
||
NormVideo;
|
||
Msg('Print: Enter filename "P" for Printer> ');
|
||
GetFileName(Filename,'LST');
|
||
Msg('Left margin > ');
|
||
Read(LeftMargin);
|
||
if FileName = 'P.LST' then
|
||
FileName := 'LST';
|
||
Msg('Printing to: ' + FileName + '....');
|
||
Assign(MCFile,FileName);
|
||
Rewrite(MCFile);
|
||
For Count := 1 to 5 do
|
||
Writeln(MCFile);
|
||
for J := 1 to FYmax do
|
||
begin
|
||
Line := '';
|
||
for I := 'A' to FXmax do
|
||
begin
|
||
with Sheet[I,J] do
|
||
begin
|
||
while (Length(Line) < XPOS[I] - 4) do
|
||
Line := Line + ' ';
|
||
if (Constant in CellStatus) or (Formula in CellStatus) then
|
||
begin
|
||
if not (Locked in CellStatus) then
|
||
begin
|
||
if DEC > 0 then
|
||
Str(Value:FW:DEC,P)
|
||
else
|
||
Str(Value:FW,P);
|
||
Line := Line + P;
|
||
end; { End if not (Locked in CellStatus) then }
|
||
end { End if or then }
|
||
else
|
||
Line := Line + Contents;
|
||
end; { End With Statement }
|
||
end; { End For Loop - have gotten one line }
|
||
For Count := 1 to LeftMargin do { Insert left margin }
|
||
Write(MCFile,' ');
|
||
writeln(MCFile,Line);
|
||
end; { End for loop - move to next line }
|
||
Grid;
|
||
Close(MCFile);
|
||
LowVideo;
|
||
GotoCell(FX,FY);
|
||
end; { End Procedure Print }
|
||
|
||
|
||
|
||
{ Procedure Help dislpays the help file CALC.HLP for the user. }
|
||
|
||
Procedure Help;
|
||
|
||
type
|
||
str80 = string[80];
|
||
Pages = array[0..200] of str80;
|
||
|
||
var
|
||
H : text;
|
||
Line : string[80];
|
||
LineCounter, EndOfFile, ErrorResult, BeginPage,
|
||
J : Integer;
|
||
Bold : boolean;
|
||
Buffer : ^Pages;
|
||
|
||
Procedure DisplayMessage;
|
||
|
||
begin
|
||
GotoXY(6,24);
|
||
NormVideo;
|
||
write('Press ');
|
||
LowVideo;
|
||
Write('`P`');
|
||
NormVideo;
|
||
Write(' for previous page ');
|
||
LowVideo;
|
||
Write('`N`');
|
||
NormVideo;
|
||
Write(' for next,');
|
||
LowVideo;
|
||
Write('`Esc`');
|
||
NormVideo;
|
||
Write(' to exit Help file.');
|
||
end;
|
||
|
||
{ Procedure GetPages reads the help file from disk into an array of a }
|
||
{ dynamicly allocated array. NOTE : the number of lines read in is kept }
|
||
{ in the zero'th index of the array. }
|
||
|
||
Procedure GetPages;
|
||
|
||
var
|
||
st : string[10];
|
||
count : integer;
|
||
|
||
begin
|
||
count := 1;
|
||
Assign(H,'CALC.HLP');
|
||
Reset(H);
|
||
while not Eof(H) do
|
||
begin
|
||
Readln(H,Buffer^[count]);
|
||
count := count + 1;
|
||
end;
|
||
close(H);
|
||
Str(count,st);
|
||
Buffer^[0] := st;
|
||
end;
|
||
|
||
|
||
|
||
begin
|
||
LineCounter := 1; { Initialize line counter}
|
||
if Exist('CALC.HLP') then
|
||
begin
|
||
New(Buffer); { Allocate dynamic array }
|
||
GetPages; { Read in Help File }
|
||
Val(Buffer^[0],EndOfFile,ErrorResult); { EndOfFile := # of Lines}
|
||
while LineCounter < EndOfFile do
|
||
begin
|
||
BeginPage := LineCounter - 1;
|
||
if BeginPage < 1 then { If Previous page is called while on }
|
||
BeginPage := 1; { first page, Beginpage is off by 1. }
|
||
ClrScr;
|
||
Bold := false;
|
||
LowVideo;
|
||
Line := Buffer^[LineCounter]; { Get first line of current page. }
|
||
|
||
{ This while loop steps through the array looking for the end of }
|
||
{ page indicator '.PA', writing out each line as it goes. }
|
||
|
||
while (LineCounter < EndOfFile) and (Line <> '.PA') do
|
||
begin
|
||
Write(' ');
|
||
For J := 1 to Length(Line) do
|
||
begin
|
||
if Line[J] = ^B then { Check for bold face type }
|
||
begin
|
||
Bold := not Bold; { Toggle Bold type }
|
||
if Bold then
|
||
NormVideo
|
||
else
|
||
LowVideo;
|
||
end
|
||
else
|
||
write(Line[J]);
|
||
end; { End for loop - have written entire line }
|
||
Writeln;
|
||
LineCounter := LineCounter + 1;
|
||
Line := Buffer^[LineCounter]; { Get next line }
|
||
end; { end while }
|
||
DisplayMessage;
|
||
repeat
|
||
read(Kbd,Ch);
|
||
until Upcase(Ch) in ['P','N',#27];
|
||
case UpCase(Ch) of
|
||
'P' : begin { Get start of previous page }
|
||
repeat
|
||
BeginPage := BeginPage - 1;
|
||
until (Buffer^[BeginPage] = '.PA') or (BeginPage < 1);
|
||
LineCounter := BeginPage + 1;
|
||
end;
|
||
'N' : LineCounter := LineCounter + 1; { Get start of next page }
|
||
#27 : LineCounter := EndOfFile; { force counter to end of file }
|
||
end;
|
||
end; { end while }
|
||
Dispose(Buffer); { Deallocate dynamic array }
|
||
UpDate; { Return to Spread Sheet }
|
||
end { End if then statement }
|
||
else { Help file did not exist }
|
||
begin
|
||
Msg('To get help the file CALC.HLP must be on your disk. Press <RETURN>');
|
||
repeat Read(kbd,Ch) until Ch=^M;
|
||
GotoCell(FX,FY);
|
||
end;
|
||
end; { End procedure Help }
|
||
|
||
|
||
{*************************************************************************}
|
||
{ MicroCalc Module 004 }
|
||
{ Last Modified 7-22-85 }
|
||
{ }
|
||
{ PURPOSE: Evaluate formulas. }
|
||
{ Recalculate spread sheet. }
|
||
{ }
|
||
{ NOTE: This module contains recursive procedures }
|
||
{*************************************************************************}
|
||
|
||
{$A-}
|
||
|
||
{ procedure NextCh returns the next Character in the formula of the cell }
|
||
{ currently being evaluated. }
|
||
|
||
procedure NextCh(var Position : Integer;
|
||
var NextChar : Char;
|
||
Formula : AnyString);
|
||
begin
|
||
repeat
|
||
Position := Position + 1;
|
||
if Position <= Length(Formula) then
|
||
NextChar := Formula[Position]
|
||
else
|
||
NextChar := eofline;
|
||
until NextChar <> ' ';
|
||
end; { End procedure NextCh }
|
||
|
||
{ procedure Evaluate evaluates a string passed to it, the string }
|
||
{ represents an expression or formula. }
|
||
|
||
procedure Evaluate(var IsFormula : Boolean;
|
||
var Formula : AnyString;
|
||
var Value : Real;
|
||
var ErrorPosition : Integer);
|
||
var
|
||
Position : Integer; { Current position in formula }
|
||
EvalCh : Char; { Current Character being scanned }
|
||
EXY : string[3]; { Intermediate string for conversion }
|
||
|
||
function Expression(var ExpressionCh : Char):Real;forward;
|
||
|
||
{ Sub-function Fact returns the factorial value of the integer passed in}
|
||
{ as it's paramater. }
|
||
|
||
function Fact(I : Real): Real;
|
||
|
||
{WARNING: This program will not compile using TURBO-87.COM unless you
|
||
have an 8087 math coprocessor installed in your computer. Use TURBO.
|
||
COM to compile}
|
||
begin
|
||
if ((I > 0.0) and (I < 34.0)) then { check if value is in legal range.}
|
||
Fact := I * Fact(I - 1) { Fact(34) is out of range. }
|
||
else
|
||
Fact := 1.0;
|
||
end; { End sub-function Fact }
|
||
|
||
{ function Factor is the meat of procedure Evaluate. Within this pro- }
|
||
{ -cedure the current subexpression is actualy evaluated. Using nested }
|
||
{ If-Then-Else statements, the function determines if the sub-expression}
|
||
{ is a number, the sum of a subrange of cells (i.e A1>A5), or a }
|
||
{ function(i.e.ABS(X) ). }
|
||
|
||
function Factor(var FactorCh : Char): Real;
|
||
|
||
type
|
||
{ Declare a set of the standard functions }
|
||
Standardfunction =
|
||
(fabs,fsqrt,fsqr,fsin,fcos,farctan,fln,flog,fexp,ffact);
|
||
|
||
{ Declare array with indices being the Standard function names. }
|
||
StandardfunctionList = array[Standardfunction] of string[6];
|
||
|
||
const
|
||
{ Declare Typed Constant array initializing it with function names }
|
||
StandardfunctionNames : StandardfunctionList =
|
||
('ABS','SQRT','SQR','SIN','COS','ARCTAN','LN','LOG','EXP','FACT');
|
||
|
||
var
|
||
E, EE, L : Integer; { temporary variables }
|
||
Found : Boolean; { boolean value - expression found or not }
|
||
CellSum, F : Real; { F holds value returned by recursive }
|
||
{ calls to Factor }
|
||
Sf : Standardfunction;
|
||
OldExpFY, { ExpEFX and ExpFY hold the positions of }
|
||
ExpFY, { the cells referenced to in any formulas }
|
||
SumFY, { SumFX and SumFY hold the sum to be }
|
||
Start : Integer; { calculated at the fromula's position }
|
||
OldExpFX, ExpFX, SumFX : ColumnName;
|
||
|
||
begin { begin main block of function Factor }
|
||
F := -1;
|
||
if FactorCh in Numbers then { Get integer or real number }
|
||
begin
|
||
Start := Position; { Save first position of number in string }
|
||
repeat { Skip to non number character }
|
||
NextCh(Position,FactorCh,Formula);
|
||
until not (FactorCh in Numbers);
|
||
if FactorCh = '.' then { is decimal point }
|
||
repeat
|
||
NextCh(Position,FactorCh,Formula);
|
||
until not (FactorCh in Numbers);
|
||
if FactorCh = 'E' then { is Exponent symbol }
|
||
begin
|
||
NextCh(Position,FactorCh,Formula);
|
||
repeat
|
||
NextCh(Position,FactorCh,Formula)
|
||
until not (FactorCh in Numbers);
|
||
end;
|
||
{ Get value of number }
|
||
Val(Copy(Formula,Start,Position - Start),F,ErrorPosition);
|
||
if FactorCh = ')' then
|
||
NextCh(Position,FactorCh,Formula);
|
||
end { end if FactorCh in Numbers }
|
||
else { FactorCh not a number }
|
||
if FactorCh = '(' then
|
||
begin
|
||
NextCh(Position,FactorCh,Formula);
|
||
F := Expression(FactorCh);
|
||
if FactorCh = ')' then {if matching paren is found then read next }
|
||
NextCh(Position,FactorCh,Formula)
|
||
else { else there is an error in the expression. }
|
||
ErrorPosition := Position;
|
||
end { End if FactorCh = '(' }
|
||
else { else FactorCh <> Number or '('}
|
||
{FactorCh may be a cell reference or function name or a function name }
|
||
if FactorCh in ['A'..'G','L','S'] then
|
||
begin
|
||
ExpFX := FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
if FactorCh in Numbers then
|
||
begin
|
||
F := 0;
|
||
EXY := FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
if FactorCh in Numbers then
|
||
begin
|
||
EXY := EXY + FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
end;
|
||
Val(EXY,ExpFY,ErrorPosition);
|
||
IsFormula := true; { the expression is a formula }
|
||
|
||
{ Check if content of the cell referenced in the formula is a }
|
||
{ constant. If so then verify that it has been calculated. If the }
|
||
{ constant has been calculated then make a recursive call to the }
|
||
{ procedure Evaluate to evaluate the contents of the cell. }
|
||
|
||
if (Constant in Sheet[ExpFX,ExpFY].CellStatus) and
|
||
not (Calculated in Sheet[ExpFX,ExpFY].CellStatus) then
|
||
begin
|
||
Evaluate(Form,Sheet[ExpFX,ExpFY].contents,f,ErrorPosition);
|
||
{ Update CellStatus to indicate that the cells value has been }
|
||
{ calculated. }
|
||
|
||
Sheet[ExpFX,ExpFY].CellStatus :=
|
||
Sheet[ExpFX,ExpFY].CellStatus + [Calculated]
|
||
end { End if ... and not ... Statement }
|
||
|
||
{ The cell refered to either didn't contain a constant or the }
|
||
{ constants value was already calculated. }
|
||
|
||
else { If the contents of the cell are not text then they must be }
|
||
{ a constant. }
|
||
if not (Txt in Sheet[ExpFX,ExpFY].CellStatus) then
|
||
F := Sheet[ExpFX,ExpFY].Value;
|
||
if FactorCh = '>' then { Check for formula range designator }
|
||
begin
|
||
OldExpFX := ExpFX;
|
||
OldExpFY := ExpFY;
|
||
NextCh(Position,FactorCh,Formula);
|
||
ExpFX := FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
if FactorCh in Numbers then
|
||
begin
|
||
EXY := FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
if FactorCh in Numbers then
|
||
begin
|
||
EXY := EXY + FactorCh;
|
||
NextCh(Position,FactorCh,Formula);
|
||
end;
|
||
if FactorCh = ')' then
|
||
NextCh(Position,FactorCh,Formula);
|
||
val(EXY,ExpFY,ErrorPosition);
|
||
Cellsum := 0;
|
||
|
||
{ visit each cell specified in sub-range of formula }
|
||
|
||
for SumFY := OldExpFY to ExpFY do
|
||
begin
|
||
for SumFX := OldExpFX to ExpFX do
|
||
begin
|
||
F := 0;
|
||
{ Note that the next few statements are identical to the }
|
||
{ statements about fifty lines back. }
|
||
if (Constant in Sheet[SumFX,SumFY].CellStatus) and
|
||
not (Calculated in Sheet[SumFX,SumFY].CellStatus) then
|
||
begin
|
||
Evaluate(Form,Sheet[SumFX,SumFY].contents,f,ErrorPosition);
|
||
Sheet[SumFX,SumFY].CellStatus :=
|
||
Sheet[SumFX,SumFY].CellStatus+[Calculated];
|
||
end
|
||
else
|
||
if not (Txt in Sheet[SumFX,SumFY].CellStatus) then
|
||
F := Sheet[SumFX,SumFY].Value;
|
||
Cellsum := Cellsum + f;
|
||
f := Cellsum;
|
||
end; { for SumFX := OldExpFX to ExpFX do }
|
||
end; { for SumFY := OldExpFY to ExpFY do }
|
||
end; { if FactorCh in Numbers then }
|
||
end { if FactorCh = '>' then }
|
||
else { FactorCh = ')' }
|
||
if FactorCh = ')' then
|
||
begin
|
||
NextCh(Position,FactorCh,Formula);
|
||
found := true;
|
||
end;
|
||
end { if FactorCh in Numbers then }
|
||
else {FactorCh is second letter in function name (i.e. ABS or LN )}
|
||
begin
|
||
found := false;
|
||
for sf := fabs to ffact do { step through all possible func's }
|
||
if not found then
|
||
begin
|
||
l := Length(StandardfunctionNames[sf]);
|
||
if copy(Formula,Position - 1,l) = StandardfunctionNames[sf] then
|
||
begin
|
||
Position := Position + l - 1;
|
||
NextCh(Position,FactorCh,Formula);
|
||
F := Expression(FactorCh);
|
||
case sf of
|
||
fabs : f := abs(f);
|
||
fsqrt : begin
|
||
if f > 0 then
|
||
f := sqrt(f) { WARNING: This progam will not
|
||
compile with TURBOBCD.COM. (Sqrt,
|
||
Sin, and similar operations are
|
||
not implemented in the BCD
|
||
version.) Use TURBO.COM to
|
||
compile. }
|
||
else
|
||
F := -1;
|
||
end;
|
||
fsqr : begin
|
||
if Abs(f) < Sqrt(exp(38) * ln(1)) then
|
||
f := sqr(f)
|
||
else
|
||
F := -1;
|
||
end;
|
||
fsin : f := sin(f);
|
||
fcos : f := cos(f);
|
||
farctan : f := arctan(f);
|
||
fln : f := ln(f);
|
||
flog : f := ln(f)/ln(10);
|
||
fexp : begin
|
||
if abs(f) < 89 then { Exp(+/-89) will cause }
|
||
f := exp(f) { floating point Overflow. }
|
||
else
|
||
f := -1;
|
||
end;
|
||
ffact : f := fact(int(f));
|
||
end; { end case }
|
||
Found := true;
|
||
end; { if then Statement }
|
||
end; { if not found Statement }
|
||
if not Found then
|
||
ErrorPosition := Position;
|
||
end; { else statement }
|
||
end; { if FactorCh in ['A'..'G'] then }
|
||
Factor := F;
|
||
end; { End Sub-function Factor}
|
||
|
||
{ Sub-function Signed Factor first determines the sign of the exp- }
|
||
{ -ression. It then calls the function Factor to get the value of the }
|
||
{ expression. }
|
||
|
||
function SignedFactor(var SignedCh : Char):Real;
|
||
|
||
begin { begin main block of procedure SignedFactor }
|
||
if SignedCh = '-' then
|
||
begin
|
||
NextCh(Position,SignedCh,Formula);
|
||
SignedFactor := -Factor(SignedCh);
|
||
end
|
||
else
|
||
SignedFactor := Factor(SignedCh);
|
||
end; { End Sub-function SignedFactor }
|
||
|
||
{ Sub-function Term returns the value of the sub-expression being eval- }
|
||
{ -uated. If the expression contains an exponent expression Term eval- }
|
||
{ -uates it. }
|
||
|
||
function Term(var TermCh : Char):Real;
|
||
|
||
var
|
||
T : Real;
|
||
|
||
begin { begin main block of procedure Term }
|
||
T := SignedFactor(TermCh);
|
||
while TermCh = '^' do
|
||
begin
|
||
NextCh(Position,TermCh,Formula);
|
||
T := exp(ln(t) * SignedFactor(TermCh));
|
||
end;
|
||
Term := T;
|
||
end; { End Sub-function Term }
|
||
|
||
{ Sub-function SimpleExpression calls the function term and evaluates }
|
||
{ the simple expression returned. }
|
||
|
||
function SimpleExpression(var SimpleExpCh : Char):Real;
|
||
|
||
var
|
||
SimpExp : Real;
|
||
Opr : Char;
|
||
|
||
begin { begin main block of procedure SimpleExpression }
|
||
SimpExp := Term(SimpleExpCh);
|
||
while SimpleExpCh in ['*','/'] do
|
||
begin
|
||
Opr := SimpleExpCh;
|
||
NextCh(Position,SimpleExpCh,Formula);
|
||
case Opr of
|
||
'*' : SimpExp := SimpExp * term(SimpleExpCh);
|
||
'/' : SimpExp := SimpExp / term(SimpleExpCh);
|
||
end;
|
||
end;
|
||
SimpleExpression := SimpExp;
|
||
end; { End Sub-function SimpleExpression }
|
||
|
||
{ Sub-function Expression evaluates the expression contained in the }
|
||
{ current cell. }
|
||
|
||
function Expression{(var ExpressionCh : Char):Real;forward};
|
||
|
||
var
|
||
E : Real;
|
||
Opr : Char;
|
||
|
||
begin { begin main block of function Expression }
|
||
E := SimpleExpression(ExpressionCh);
|
||
while ExpressionCh in ['+','-'] do
|
||
begin
|
||
Opr := ExpressionCh;
|
||
NextCh(Position,ExpressionCh,Formula);
|
||
case Opr of
|
||
'+' : E := E +
|
||
SimpleExpression(ExpressionCh);
|
||
'-' : E := E -
|
||
SimpleExpression(ExpressionCh);
|
||
end;
|
||
end;
|
||
Expression := E;
|
||
end; { End Sub-function Expression }
|
||
|
||
begin { main body of procedure Evaluate }
|
||
if Formula[1] = '.' then
|
||
Formula := '0' + Formula;
|
||
if Formula[1] = '+' then
|
||
delete(Formula,1,1);
|
||
IsFormula := false;
|
||
Position := 0;
|
||
NextCh(Position,EvalCh,Formula);
|
||
Value := Expression(EvalCh);
|
||
if EvalCh = EofLine then
|
||
ErrorPosition := 0
|
||
else
|
||
ErrorPosition := Position;
|
||
end; { End procedure Evaluate }
|
||
|
||
{ procedure Recalculate steps through the entire spreadsheet recalculating}
|
||
{ each cell. }
|
||
|
||
procedure Recalculate;
|
||
var
|
||
RFX : ColumnName;
|
||
RFY : Integer;
|
||
OldValue : Real;
|
||
Err : Integer;
|
||
|
||
begin
|
||
LowVideo;
|
||
GotoXY(1,24);
|
||
ClrEol;
|
||
Write('Calculating..');
|
||
for RFY := 1 to FYMax do { Reevaluate each cell updating it's }
|
||
begin { contents when appropriate. }
|
||
for RFX := 'A' to FXMax do
|
||
begin
|
||
with Sheet[RFX,RFY] do
|
||
begin
|
||
if (Formula in CellStatus) then
|
||
begin
|
||
CellStatus := CellStatus + [Calculated];
|
||
OldValue := Value;
|
||
Evaluate(Form,Contents,Value,Err);
|
||
if OldValue <> Value then
|
||
begin
|
||
GotoXY(XPos[RFX],RFY + 1);
|
||
if (DEC >= 0) then
|
||
Write(Value:FW:DEC)
|
||
else
|
||
Write(Value:FW);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
GotoCell(FX,FY);
|
||
end; { End procedure Recalculate }
|
||
|
||
{*************************************************************************}
|
||
{ MicroCalc Module 005 }
|
||
{ Last Modified 7-22-85 }
|
||
{ }
|
||
{ PURPOSE: Read the contents of a cell and update }
|
||
{ associated cells. }
|
||
{ }
|
||
{*************************************************************************}
|
||
|
||
{ procedure GetCell gets the contents of a cell from the user. This }
|
||
{ routine gets all input entered by the user. procedure GetCell }
|
||
{ initializes the temporary variable "S" with the last read Character. }
|
||
{ Depending on this character, it then calls GetFormula, GetText, or }
|
||
{ EditCell. }
|
||
|
||
procedure GetCell(FX : ColumnName; FY : Integer);
|
||
var
|
||
S : AnyString;
|
||
NewStatus : SetofAttri;
|
||
ErrorPosition : Integer;
|
||
EvalResult : Real;
|
||
I : ColumnName;
|
||
Abort,
|
||
IsForm : Boolean;
|
||
|
||
{ Sub-procedure ClearCells clears the current cell and its associated }
|
||
{ cells. An associated cell is a cell overwritten by data from the cur- }
|
||
{ -rent cell. The data can be text in which case the cell has the attri-}
|
||
{ -bute "OverWritten". If the data is a result from an expression and }
|
||
{ the field width is larger than 11 then the associated cell is }
|
||
{ "Locked." }
|
||
|
||
procedure ClearCells(FX : ColumnName; FY : Integer);
|
||
var
|
||
I : ColumnName;
|
||
|
||
begin
|
||
I := FX;
|
||
repeat
|
||
with Sheet[I,FY] do
|
||
begin
|
||
GotoXY(XPos[I],FY + 1);
|
||
write(' ');
|
||
I := Succ(I);
|
||
end;
|
||
{ Cell is not OverWritten not Locked }
|
||
until ([OverWritten,Locked] * Sheet[I,FY].CellStatus = []);
|
||
end; { End Sub-procedure ClearCells }
|
||
|
||
{ Sub-procedure GetLine is the routine used to get input from the user. }
|
||
{ The procedure allows editing of input and checks that the input con- }
|
||
{ -tains legal characters. }
|
||
|
||
procedure GetLine(ColNO, LineNO, { Where to start line }
|
||
MAX : Integer; { Max length }
|
||
UpperCase : Boolean);{ True if auto Upcase }
|
||
var
|
||
X : Integer;
|
||
InsertOn : boolean;
|
||
OkChars : set of Char;
|
||
|
||
procedure GotoX;
|
||
begin
|
||
GotoXY(X + ColNo - 1,LineNo);
|
||
end;
|
||
|
||
begin
|
||
OkChars := [' '..'}'];
|
||
InsertOn := true;
|
||
X := 1;
|
||
GotoX;
|
||
Write(S);
|
||
if Length(S) = 1 then
|
||
X := 2;
|
||
if ErrorPosition <> 0 then { there was an error found }
|
||
X := ErrorPosition;
|
||
GotoX;
|
||
repeat
|
||
Read(Kbd,Ch);
|
||
if KeyPressed then
|
||
begin
|
||
Read(kbd,Ch);
|
||
IBMCh(Ch);
|
||
end;
|
||
if UpperCase then
|
||
Ch := UpCase(Ch);
|
||
case Ch of
|
||
^[ : begin
|
||
S := chr($FF); { abort editing }
|
||
Ch := ^M;
|
||
end;
|
||
^D : begin { Move cursor right }
|
||
X := X + 1;
|
||
if (X > length(S) + 1) or (X > MAX) then
|
||
X := X - 1;
|
||
GotoX;
|
||
end;
|
||
^G : begin { Delete Char under cursor }
|
||
if X <= Length(S) then
|
||
begin
|
||
Delete(S,X,1);
|
||
Write(copy(S,X,Length(S) - X + 1),' ');
|
||
GotoX;
|
||
end;
|
||
end;
|
||
^S,^H : begin { Move cursor left }
|
||
X := X - 1;
|
||
if X < 1 then
|
||
X := 1;
|
||
GotoX;
|
||
end;
|
||
^F : begin { Move cursor to end of line }
|
||
X := Length(S) + 1;
|
||
GotoX;
|
||
end;
|
||
^A : begin { Move cursor to beginning of line }
|
||
X := 1;
|
||
GotoX;
|
||
end;
|
||
#127 : begin { Delete left Char }
|
||
X := X - 1;
|
||
if (Length(S) > 0) and (X > 0) then
|
||
begin
|
||
Delete(S,X,1);
|
||
Write(copy(S,X,Length(S) - X + 1),' ');
|
||
GotoX;
|
||
if X < 1 then
|
||
X := 1;
|
||
end
|
||
else
|
||
X := 1;
|
||
end;
|
||
^V : InsertOn := not InsertOn; { Toggle Insert/Overwrite }
|
||
else { Not Upcase }
|
||
begin
|
||
if Ch in OkChars then
|
||
begin
|
||
if InsertOn then
|
||
begin
|
||
insert(Ch,S,X);
|
||
Write(copy(S,X,Length(S) - X + 1),' ');
|
||
end
|
||
else
|
||
begin
|
||
write(Ch);
|
||
if X = length(S) then
|
||
S := S + Ch
|
||
else
|
||
S[X] := Ch;
|
||
end;
|
||
if Length(S) + 1 <= MAX then
|
||
X := X + 1
|
||
else
|
||
OkChars := []; { Line too Long }
|
||
GotoX;
|
||
end { end if Ch in OkChars }
|
||
else
|
||
if Length(S) + 1 <= Max then
|
||
OkChars:= [' '..'}']; { Line ok again }
|
||
end; { end case statement's else }
|
||
end; { end case statement }
|
||
until CH = ^M;
|
||
end; { End Sub-procedure GetLine }
|
||
|
||
{ Sub-procedure GetText calls the procedure GetLine with the current }
|
||
{ cells X,Y position as parameters. This means that text entering takes }
|
||
{ place direcly at the cells position on the Sheet. }
|
||
|
||
procedure GetText;
|
||
var
|
||
LineLength : Integer;
|
||
|
||
begin
|
||
GotoXY(5,23);
|
||
LowVideo;
|
||
if FX = 'G' then
|
||
LineLength := 10
|
||
else
|
||
LineLength := 70;
|
||
with Sheet[FX,FY] do
|
||
GetLine(XPos[FX],FY+1,LineLength,False);
|
||
end; { End Sub-procedure GetText }
|
||
|
||
{ Sub-procedure GetFormula calls the routine GetLine to get a line from }
|
||
{ the user. It then calls the routine Evaluate to evaluate the Formula }
|
||
{ input by the user. }
|
||
|
||
procedure GetFormula;
|
||
|
||
begin
|
||
GotoXY(5,23);
|
||
LowVideo;
|
||
repeat
|
||
GetLine(1,24,70,True);
|
||
if S <> Chr($FF) then
|
||
begin
|
||
Evaluate(IsForm,S,EvalResult ,ErrorPosition);
|
||
if ErrorPosition <> 0 then
|
||
Flash(15,'GetFormula Error at cursor' + ^G,false)
|
||
else
|
||
Flash(15,'get formula ok',false);
|
||
end;
|
||
until (ErrorPosition = 0) or (S = Chr($FF));
|
||
if IsForm then
|
||
NewStatus := NewStatus + [Formula];
|
||
end; { End Sub-procedure GetFormula }
|
||
|
||
{ Sub-procedure EditCell loads a copy of the current cell's contents }
|
||
{ into the variable S before calling either GetText or GetFormula. In }
|
||
{ this way no changes are actually made to the current cell. }
|
||
|
||
procedure EditCell;
|
||
begin
|
||
GotoXY(5,23);
|
||
with Sheet[FX,FY] do
|
||
begin
|
||
S := Contents;
|
||
if Txt in CellStatus then
|
||
GetText
|
||
else
|
||
GetFormula;
|
||
end;
|
||
end; { End procedure EditCell }
|
||
|
||
{ Sub-procedure UpdateCells is a little more complicated. Basically it }
|
||
{ makes sure to tag and untag cells which have been overwritten or }
|
||
{ cleared by data from another cell. It also updates the current cell }
|
||
{ with the new type and contents which are still in the temporary }
|
||
{ variable "S". }
|
||
|
||
procedure UpdateCells;
|
||
var
|
||
I : ColumnName;
|
||
Flength : Integer;
|
||
|
||
begin
|
||
Sheet[FX,FY].Contents := S;
|
||
if Txt in NewStatus then
|
||
begin
|
||
I := FX;
|
||
FLength := Length(S);
|
||
repeat { this repeat loop checks the status of adjoining cells to }
|
||
{ verify that they have or have not been overwritten. }
|
||
I := Succ(I);
|
||
with Sheet[I,FY] do
|
||
begin
|
||
FLength := Flength - 11;
|
||
if (Flength > 0) then
|
||
begin
|
||
CellStatus := [Overwritten,Txt];
|
||
Contents := '';
|
||
end
|
||
else
|
||
begin
|
||
if OverWritten in CellStatus then
|
||
begin
|
||
CellStatus := [Txt];
|
||
GotoCell(I,FY);
|
||
LeaveCell(I,FY);
|
||
end; { if OverWritten in CellStatus }
|
||
end; { else }
|
||
end; { with Sheet[I,FY] do }
|
||
until (I = FXMax) or (Sheet[I,FY].Contents <> '');
|
||
Sheet[FX,FY].CellStatus := [Txt];
|
||
end
|
||
else { string changed to formula or constant }
|
||
begin
|
||
I := FX;
|
||
repeat { this repeat loop checks whether or not the cell is }
|
||
{ overwritten. }
|
||
with Sheet[I,FY] do
|
||
begin
|
||
if OverWritten in CellStatus then
|
||
begin
|
||
CellStatus := [Txt];
|
||
Contents := '';
|
||
end;
|
||
I := Succ(I);
|
||
end;
|
||
until not (OverWritten in Sheet[I,FY].CellStatus);
|
||
with Sheet[FX,FY] do
|
||
begin
|
||
CellStatus := [Constant];
|
||
if IsForm then
|
||
CellStatus := CellStatus + [Formula];
|
||
Value := EvalResult ;
|
||
end; { with }
|
||
end; { else }
|
||
end; { End Sub-procedure UpdateCells }
|
||
|
||
begin { begin main block of procedure GetCell }
|
||
S := Ch;
|
||
ErrorPosition := 0;
|
||
Abort := false;
|
||
NewStatus := [];
|
||
EvalResult := -1;
|
||
if Ch in ['0'..'9','+','-','.','(',')'] then
|
||
begin
|
||
NewStatus := [Constant];
|
||
if not (Formula in Sheet[FX,FY].CellStatus) then
|
||
begin
|
||
GotoXY(11,24);
|
||
ClrEol;
|
||
ClearCells(FX,FY);
|
||
GetFormula;
|
||
end
|
||
else { Formula in Sheet[FX,FY].CellStatus }
|
||
begin
|
||
Flash(15,'Edit formula Y/N?',true);
|
||
repeat
|
||
read(Kbd,Ch)
|
||
until UpCase(CH) in ['Y','N'];
|
||
Flash(15,' ',false);
|
||
if UpCase(Ch) = 'Y' then
|
||
begin
|
||
EditCell;
|
||
end
|
||
Else
|
||
Abort := true;
|
||
end;
|
||
end
|
||
else { Ch not in ['0'..'9','+','-','.','(',')'] }
|
||
begin
|
||
if Ch = ^[ then
|
||
begin
|
||
NewStatus := (Sheet[FX,FY].CellStatus) * [Txt,Constant];
|
||
EditCell;
|
||
end
|
||
else { Ch <> '^[' and not in ['0'..'9','+','-','.','(',')'] }
|
||
begin
|
||
if formula in Sheet[FX,FY].CellStatus then
|
||
begin
|
||
Flash(15,'Edit formula Y/N?',true);
|
||
repeat
|
||
read(Kbd,Ch)
|
||
until UpCase(CH) in ['Y','N'];
|
||
Flash(15,' ',false);
|
||
if UpCase(Ch) = 'Y' then
|
||
begin
|
||
EditCell;
|
||
end
|
||
Else
|
||
Abort := true;
|
||
end
|
||
else { formula not in Sheet[FX,FY].CellStatus }
|
||
begin
|
||
NewStatus := [Txt];
|
||
ClearCells(FX,FY);
|
||
GetText;
|
||
end; { End else }
|
||
end; { end else }
|
||
end; { end else }
|
||
if not Abort then { do neccesary bookkeeping }
|
||
begin
|
||
if S <> Chr($FF) then
|
||
UpDateCells;
|
||
GotoCell(FX,FY);
|
||
if AutoCalc and (Constant in Sheet[FX,FY].CellStatus) then
|
||
Recalculate;
|
||
if Txt in NewStatus then
|
||
begin
|
||
GotoXY(3,FY + 1);
|
||
Clreol;
|
||
For I := 'A' to FXMax do
|
||
LeaveCell(I,FY);
|
||
end;
|
||
end; { end if not abort }
|
||
Flash(15,' ',False);
|
||
GotoCell(FX,FY);
|
||
end; { End procedure GetCell }
|
||
|
||
{ procedure Format is used to modify the numeric format of a range of }
|
||
{ cells in the current column. }
|
||
|
||
procedure Format;
|
||
var
|
||
J, FW, DEC,
|
||
FromLine, ToLine : Integer;
|
||
Lock : Boolean;
|
||
|
||
{ procedure GetInt reads an integer from the keyboard screening it for }
|
||
{ illegal characters. }
|
||
|
||
procedure GetInt(var I: Integer; Max: Integer);
|
||
var
|
||
S : String[8];
|
||
Result : Integer;
|
||
Ch : Char;
|
||
|
||
begin
|
||
S := '';
|
||
repeat
|
||
repeat Read( Kbd,Ch) until Ch in ['0'..'9','-',^M];
|
||
if Ch <> ^M then
|
||
begin
|
||
Write(Ch);
|
||
S := S + Ch;
|
||
Val(S,I,Result);
|
||
end;
|
||
until (I >= Max) or (Ch = ^M);
|
||
if I > Max then I := Max;
|
||
end; { End Subprocedure GetInt }
|
||
|
||
begin
|
||
NormVideo;
|
||
Msg('Format: Enter number of places beyond decimal point (Max 11) : ');
|
||
GetInt(DEC,11);
|
||
Msg('Enter Cell width (if larger than 10 next column will be locked) : ');
|
||
GetInt(FW,20);
|
||
Msg('From which line in column '+ FX +' : ');
|
||
GetInt(FromLine,FYMax);
|
||
Msg('To which line in column '+ FX +' : ');
|
||
GetInt(ToLine,FYMax);
|
||
if FW > 10 then
|
||
Lock := true
|
||
else
|
||
Lock := False;
|
||
for J := FromLine to ToLine do { Format specified cells within }
|
||
begin { current column. }
|
||
Sheet[FX,J].DEC := DEC;
|
||
Sheet[FX,J].FW := FW;
|
||
with Sheet[Succ(FX),J] do
|
||
begin
|
||
if Lock then
|
||
begin
|
||
CellStatus := CellStatus + [Locked,Txt];
|
||
Contents := '';
|
||
end
|
||
else
|
||
CellStatus :=CellStatus - [Locked];
|
||
end; { End With Statement }
|
||
end; { End For Loop }
|
||
NormVideo;
|
||
UpDate;
|
||
GotoCell(FX,FY);
|
||
end; { End procedure Format }
|
||
|
||
{ Procedure Commands is called from the program's main loop when the user }
|
||
{ types a slash '/'. The procedure in turn calls the appropriate procedure}
|
||
{ based on the users response to the menu displayed. }
|
||
{ }
|
||
{ For easy reference the source code module number is shown in a comment }
|
||
{ on the right following the procedure call. }
|
||
|
||
Procedure Commands;
|
||
|
||
begin
|
||
GotoXY(1,24);
|
||
NormVideo;
|
||
Write('Update, Quit, Load, Save, Recalculate, Print, Format, AutoCalc, Help ');
|
||
ClrEol;
|
||
Read(KBD,Ch);
|
||
Ch := UpCase(Ch);
|
||
case Ch of { module # }
|
||
'Q': Halt; { Halt execution of program }
|
||
'F': Format; { Format a range of cells 005 }
|
||
'S': Save; { Save the current spreadsheet to a file 003 }
|
||
'L': Load; { Load a spreadsheet from a file 003 }
|
||
'H': Help; { Call the Help procedure 003 }
|
||
'R': Recalculate; { Recalculate spreadsheet 005 }
|
||
'A': Auto; { Toggle AutoCalc On or Off 000 }
|
||
'U': Update; { Redraw the screen 001 }
|
||
'C': Clear; { Clear screen of spreadsheet 001 }
|
||
'P': Print; { Print spreadsheet to a file 003 }
|
||
end;
|
||
Grid; { 001 }
|
||
GotoCell(FX,FY); { 002 }
|
||
end; { End Procedure Commands }
|
||
|