⟦8d7478818⟧

TextFile

æ.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»
DataMuseum.dk

CP/M

⟦8d7478818⟧ TextFile

Derivation

TextFile
