Rev 618 | Blame | Compare with Previous | Last modification | View Log | Download
{.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 }varX: integer;InsertOn: boolean;OkChars: set of Char;procedure GotoX;beginGotoXY(X+ColNo-1,LineNo);end;beginOkChars:=[' '..'}'];InsertOn:=true;X:=1; GotoX;Write(S);if Length(S)=1 then X:=2;if ErrPos<>0 then X:=ErrPos;GotoX;repeatRead(Kbd,Ch);if UpperCase then Ch:=UpCase(Ch);case Ch of^[: beginS:=chr($FF); { abort editing }Ch:=^M;end;#251{^D}: begin { Move cursor right }X:=X+1;if (X>length(S)+1) or (X>MAX) then X:=X-1;GotoX;end;#252{^G}: begin { Delete right char }if X<=Length(S) thenbeginDelete(S,X,1);Write(copy(S,X,Length(S)-X+1),' ');GotoX;end;end;#248{^S,^H}: begin { Move cursor left }X:=X-1;if X<1 then X:=1;GotoX;end;#30{^F}: begin { Move cursor to end of line }X:=Length(S)+1;GotoX;end;#28{^A}: begin { Move cursor to beginning of line }X:=1;GotoX;end;#8{#127}: begin { Delete left char }X:=X-1;if (Length(S)>0) and (X>0) thenbeginDelete(S,X,1);Write(copy(S,X,Length(S)-X+1),' ');GotoX;if X<1 then X:=1;end else X:=1;end;#29{^V}: InsertOn:= not InsertOn;{.PA}elsebeginif Ch in OkChars thenbeginif InsertOn thenbegininsert(Ch,S,X);Write(copy(S,X,Length(S)-X+1),' ');end elsebeginwrite(Ch);if X=length(S) then S:=S+Chelse S[X]:=Ch;end;if Length(S)+1<=MAX then X:=X+1else OkChars:=[]; { Line too Long }GotoX;end elseif Length(S)+1<=Max thenOkChars:= [' '..'}']; { Line ok again }end;end;until CH=^M;end;{.PA}procedure GetCell(FX: ScreenIndex;FY: Integer);varS: 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;beginI:=FX;repeatwith Screen[I,FY] dobeginGotoXY(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;beginLowVideo;GotoXY(5,23);NormVideo;end;