|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11136 (0x2b80)
Types: TextFile
Names: »MC-MOD05.INC«
└─⟦d482c3728⟧ Bits:30005987 Turbo Pascal v2.00A (Jet80)
└─ ⟦this⟧ »MC-MOD05.INC«
æ.PAå
æ*******************************************************************å
æ* SOURCE CODE MODULE: MC-MOD05 *å
æ* PURPOSE: Read the contents of a cell and update *å
æ* associated cells. *å
æ*******************************************************************å
æ Procedure GetLine will let the user type and/or edit a string of å
æ maximum length "MAX". The string will start at cursor position: å
æ ColNO,LineNO. If ErrPos <> 0 then the cursor will jump to position å
æ ErrPos in the string. If the last parameter is "True" then all å
æ characters entered will be translated to upper case. å
æ If the user at anytimes types <ESCAPE> then the string returned å
æ contain $FF to indicate that editing was aborted. å
procedure GetLine(var S: AnyString; æ String to edit å
ColNO,LineNO, æ Where start line å
MAX, æ Max length å
ErrPos: integer; æ Where to begin å
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 ErrPos<>0 then X:=ErrPos;
GotoX;
repeat
Read(Kbd,Ch);
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 right char å
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;
æ.PAå
else
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 else
if Length(S)+1<=Max then
OkChars:= Æ' '..'å'Å; æ Line ok again å
end;
end;
until CH=^M;
end;
æ.PAå
procedure GetCell(FX: ScreenIndex;FY: Integer);
var
S: AnyString;
NewStat: Set of Attributes;
ErrorPosition: Integer;
I: ScreenIndex;
Result: Real;
Abort: Boolean;
IsForm: Boolean;
æ Procedure ClearCells clears the current cell and its associated å
æ cells. An associated cell is a cell overwritten by data from the å
æ current cell. The data can be text in which case the cell has the å
æ attribute "OverWritten". If the data is a result from an expressionå
æ and the field with is larger tahn 11 then the cell is "Locked" å
procedure ClearCells;
begin
I:=FX;
repeat
with ScreenÆI,FYÅ do
begin
GotoXY(XPosÆIÅ,FY+1);
write(' '); I:=Succ(I);
end;
until (ÆOverWritten,LockedÅ*ScreenÆI,FYÅ.CellStatus=ÆÅ);
æ Cell is not OVerWritten not Locked å
end;
æ.CP20å
æ The new type of the cell is flashed at the bottom of the screen å
æ Notice that a constant of type array is used to indicate the type å
procedure FlashType;
begin
HighVideo;
GotoXY(5,23);
LowVideo;
end;
æ.CP20å
æ Procedure GetFormula repeats calling the procedure GetLine and å
æ Evaluate until the line read by GetLine contains a valid formula. å
æ Evaluate returns an error position in the string evaluated. If å
æ this position is non zero GetLine is called. If the user types å
æ ESC in GetLine to abort the editing then the string returned from å
æ Getline will contain $FF and te original value of the cell will å
æ be restored later. å
procedure GetFormula;
begin
FlashType;
repeat
GetLine(S,1,24,70,ErrorPosition,True);
if S<>Chr($FF) then
begin
Evaluate(IsForm,S,Result,ErrorPosition);
if ErrorPosition<>0 then
Flash(15,'Error at cursor'+^G,false)
else Flash(15,' ',false);
end;
until (ErrorPosition=0) or (S=Chr($FF));
if IsForm then NewStat:=NewStat+ÆFormulaÅ;
end;
æ.CP20å
æ 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 posion on the screen. å
procedure GetText;
begin
FlashType;
with ScreenÆFX,FYÅ do GetLine(S,XPosÆFXÅ,FY+1,70,ErrorPosition,False);
end;
æ.CP20å
æ Procedure EditCell loads a copy of the current cells contents in å
æ in the variable S before calling either GetText or GetFormula. In å
æ this way no changes are made to the current cell. å
procedure EditCell;
begin
with ScreenÆFX,FYÅ do
begin
S:=Contents;
if Txt in CellStatus then GetText else GetFormula;
end;
end;
æ.PAå
æ Procedure UpdateCells is a little more complicated. Basically it å
æ makes sure to tag and untag cells which has been overwritten or å
æ cleared from data from another cell. It also updates the current å
æ with the new type and the contents which still is in the temporaly å
æ variable "S". å
procedure UpdateCells;
var
Flength: Integer;
begin
ScreenÆFX,FYÅ.Contents:=S;
if Txt in NewStat æScreenÆFX,FYÅ.CellStatuså then
begin
I:=FX; FLength:=Length(S);
repeat
I:=Succ(I);
with ScreenÆ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;
end;
end;
until (I=FXMax) or (ScreenÆI,FYÅ.Contents<>'');
ScreenÆFX,FYÅ.CellStatus:=ÆTxtÅ;
end else æ string changed to formula or constant å
begin æ Event number two å
I:=FX;
repeat
with ScreenÆI,FYÅ do
begin
if OverWritten in CellStatus then
begin
CellStatus:=ÆTxtÅ;
Contents:='';
end;
I:=Succ(I);
end;
until not (OverWritten in ScreenÆI,FYÅ.CellStatus);
with ScreenÆFX,FYÅ do
begin
CellStatus:=ÆConstantÅ;
if IsForm then CellStatus:=CellStatus+ÆFormulaÅ;
Value:=Result;
end;
end;
end;
æ.PAå
æ Procedure GetCell finnaly starts here. This procedure uses all å
æ all the above local procedures. First it initializes the temporaly å
æ variable "S" with the last read character. It then depending on å
æ this character calls GetFormula, GetText, or EditCell. å
begin æ procedure GetCell å
S:=Ch; ErrorPosition:=0; Abort:=false;
NewStat:=ÆÅ;
if Ch in Æ'0'..'9','+','-','.','(',')'Å then
begin
NewStat:=ÆConstantÅ;
if not (Formula in ScreenÆFX,FYÅ.CellStatus) then
begin
GotoXY(11,24); ClrEol;
ClearCells;
GetFormula;
end else
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 EditCell Else Abort:=true;
end;
end else
begin
if Ch=^Æ then
begin
NewStat:=(ScreenÆFX,FYÅ.CellStatus)*ÆTxt,ConstantÅ;
EditCell;
end else
begin
if formula in ScreenÆ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 EditCell Else Abort:=true;
end else
begin
NewStat:=ÆTxtÅ;
ClearCells;
GetText;
end;
end;
end;
if not Abort then
begin
if S<>Chr($FF) then UpDateCells;
GotoCell(FX,FY);
if AutoCalc and (Constant in ScreenÆFX,FYÅ.CellStatus) then Recalculate;
if Txt in NewStat then
begin
GotoXY(3,FY+1); Clreol;
For I:='A' to FXMax do
LeaveCell(I,FY);
end;
end;
Flash(15,' ',False);
GotoCell(FX,FY);
end;
æ.PAå
æ Procedure Format is used to å
procedure Format;
var
J,FW,DEC,
FromLine,ToLine: integer;
Lock: Boolean;
procedure GetInt(var I: integer; Max: Integer);
var
S: stringÆ8Å;
Err: 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,Err);
end;
until (I>=Max) or (Ch=^M);
if I>Max then I:=Max;
end;
begin
HighVideo;
Msg('Format: Enter number of decimals (Max 11): ');
GetInt(DEC,11);
Msg('Enter Cell whith remember if larger than 10 next column will lock: ');
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
begin
ScreenÆFX,JÅ.DEC:=DEC;
ScreenÆFX,JÅ.FW:=FW;
with ScreenÆSucc(FX),JÅ do
begin
if Lock then
begin
CellStatus:=CellStatus+ÆLocked,TxtÅ;
Contents:='';
end else CellStatus:=CellStatus-ÆLockedÅ;
end;
end;
NormVideo;
UpDate;
GotoCell(FX,FY);
end;
«eof»