⟦64d48e3a5⟧

TextFile

(* REGN4.PAS INCLUDE FILE *)

æ* purpose: read the contents of a cell and UPDATE associated cells *å

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
 apos,x: integer;
 inserton: boolean;
 okchars: set of char;

 PROCEDURE GOTOX;
 begin
   gotoxy(x+colno-2,lineno-1);
 end;

begin
 okchars:=Æ' '..'å'Å;
 inserton:=false;
 x:=1; GOTOX;
 write(ulnon,s);
 if len(s)=1 then x:=2;
 if errpos<>0 then x:=errpos;
 GOTOX;
 repeat
  ch:=KEY;
  if uppercase then ch:=UPCASE(ch);
  case ch of
    esc: begin
          s:=chr($FF); æ abort editing å
          ch:=return;
         end;
 hoejre: begin æ move cursor right å
          x:=x+1;
          if (x>len(s)+1) or (x>max) then x:=x-1;
          GOTOX;
         end;
    del: begin æ delete right char å
          if x<=len(s) then begin
           delete(s,x,1);
           write(copy(s,x,len(s)-x+1),ulnoff,' ',ulnon);
           GOTOX;
          end;
         end;
    ins: begin æ insert char å
          insert(' ',s,x);
          if len(s)>max then s:=copy(s,1,max);
          write(copy(s,x,len(s)-x+1));
          GOTOX;
         end;
venstre: begin æ move cursor left å
          x:=x-1;
          if x<1 then x:=1;
          GOTOX;
         end;
   htab: begin æ move cursor to end of line å
          x:=len(s)+1;
          GOTOX;
         end;
   vtab: begin æ move cursor to beginning of line å
          x:=1;
          GOTOX;
         end;
delleft: begin æ delete left char å
          x:=x-1;
          if (len(s)>0) and (x>0)  then begin
           delete(s,x,1);
           GOTOX;
           write(copy(s,x,len(s)-x+1),ulnoff,' ',ulnon);
           GOTOX;
           if x<1 then x:=1;
          end else
           x:=1;
         end;
     ^V: inserton:= not inserton;
  otherwise
   begin
    if ch in okchars  then begin
     if inserton then begin
      insert(ch,s,x);
      write(copy(s,x,len(s)-x+1),' ');
     end else begin
      write(ch);
      if x>len(s) then
       s:=s+ch
      else
       sÆxÅ:=ch;
     end;
     x:=x+1;
     if (x>len(s)+1) or (x>max) then x:=x-1;
     GOTOX;
    end;
  end;
  end;
 until ch=return;
 write(ulnoff);
end;

PROCEDURE NABORYD(i:sheetindex;fy:integer);
begin
 gotoxy(xposÆiÅ,fy);write('           ');
 sheetÆi,fyÅ.cellstatus:=ÆtxtÅ;
 GOTOCELL(i,fy);LEAVECELL(i,fy);
 if i<fxmax then  begin
  i:=succ(i);
  while (i<=fxmax) and (overwritten in sheetÆi,fyÅ.cellstatus) do begin
   gotoxy(xposÆiÅ,fy);write('           ');
   sheetÆi,fyÅ.cellstatus:=sheetÆi,fyÅ.cellstatus-ÆoverwrittenÅ;
   GOTOCELL(i,fy);LEAVECELL(i,fy);
   if i<fxmax then i:=succ(i);
  end;
 end;
end;

PROCEDURE GETCELL(fx: sheetindex;fy: integer);
var
 newstat:       set of attributes;
 errorposition: integer;
 i:             sheetindex;
 result:        real;
 abort:         boolean;
 isform:        boolean;

æ CLEARCELLS clears the current cell and its associated cells on screen å

 PROCEDURE CLEARCELLS;
 var
  renset:boolean;
 begin
  i:=fx;renset:=false;
  while (i<fxmax) and not renset do begin
   gotoxy(xposÆiÅ,fy);
   write(copy(tom,1,11));
   i:=succ(i);
   if (Æoverwritten,lockedÅ*sheetÆi,fyÅ.cellstatus=ÆÅ) then renset:=true;
  end; 
 end;
 
 PROCEDURE GETFORMULA;
 var
  parenteser:integer;
  fejltype,taltest:byte;
  cifre,tallenok,talok,flashed:boolean;
 begin
  flashed:=false;
  repeat
   tallenok:=true;cifre:=true;parenteser:=0;fejltype:=0;
   GETLINE(eline,1,24,maxtegn,errorposition,true);
   errorposition:=1;
   if eline<>chr($FF) then begin
    talok:=false;
    newstat:=newstat-ÆonscreenÅ;
    beregnet:=true;
    upfx:=fx;upfy:=fy;
    for taltest:=1 to len(eline) do begin
     if elineÆtaltestÅ in Æ'0'..'9'Å then talok:=true;
     if elineÆtaltestÅ in Æ'A'..'Z','(',')'Å then cifre:=false;
     if elineÆtaltestÅ='(' then parenteser:=parenteser+1;
     if elineÆtaltestÅ=')' then parenteser:=parenteser-1;
    end;
    if cifre then begin
     if len(eline)>33 then begin
      talok:=false;
      fejltype:=1;
      errorposition:=34;
     end;
    end else
     if parenteser<>0 then begin
      talok:=false;
      fejltype:=2;
      if parenteser>0 then
       errorposition:=len(eline)
      else begin
       errorposition:=0;
       parenteser:=0;
       while parenteser>=0 do begin
        errorposition:=errorposition+1;
        if elineÆerrorpositionÅ='(' then parenteser:=parenteser+1;
        if elineÆerrorpositionÅ=')' then parenteser:=parenteser-1;
       end;
      end; 
     end;
    if talok then begin
     fejltype:=0;
     errorposition:=SYNTAX(eline);
     if errorposition=0 then EVALUATE(isform,eline,result,errorposition);
    end;
    if errorposition<>0 then begin
     flashed:=true;
     case fejltype of
      1:FLASH(13,'    For mange cifre    '+bell,false);
      2:FLASH(13,'     Parentes- fejl    '+bell,false);
     otherwise
      FLASH(13,'    Fejl ved cursor    '+bell,false);
     end;
     FORTRYDTEKST;
    end;
   end;
  until (errorposition=0) or (eline=chr($FF));
  if flashed then begin
   FJERNFLASH(13,23);
   FLASH(37,'  Tast  /  for kommando  ',false);
  end;
  if isform then newstat:=newstat+ÆformulaÅ;
  if beregnet then newstat:=newstat+ÆonscreenÅ;
 end;

æ GETTEXT calls the procedure GETLINE for processing of text å

 PROCEDURE GETTEXT;
 begin
  with sheetÆfx,fyÅ do GETLINE(eline,xposÆfxÅ+1,fy+1,maxtegn+2-xposÆfxÅ,errorposition,false);
 end;

æ EDITCELL loads a copy of the current cells contents in  eline å

 PROCEDURE EDITCELL;
 begin
  with sheetÆfx,fyÅ do begin
   eline:=contents;
   if txt in cellstatus then GETTEXT else GETFORMULA;
  end;
 end;

æ 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 width, the newå
æ type and the contents which still is in the temporarly variable "eline".å

 PROCEDURE UPDATECELLS;
 var
  flength: integer;
  opdateret:boolean;
 begin
  sheetÆfx,fyÅ.contents:=eline;
  if txt in newstat then begin
   i:=fx;
   flength:=len(eline);
   opdateret:=false;
   repeat
    if i<fxmax then begin
     i:=succ(i);
     with sheetÆi,fyÅ do begin
      flength:=flength-(normwidth+1);
      if (flength>0) then begin
       if locked in cellstatus then
        cellstatus:=Ælocked,overwritten,txtÅ
       else
        cellstatus:=Æoverwritten,txtÅ;
       contents:='';
      end else begin
       if overwritten in cellstatus then begin
        cellstatus:=cellstatus-ÆoverwrittenÅ;
        GOTOCELL(i,fy);LEAVECELL(i,fy);
       end;
      end;
     end;
    end;
   until (i=fxmax)  or (sheetÆi,fyÅ.contents<>'');
   sheetÆfx,fyÅ.cellstatus:=ÆtxtÅ;
  end else begin         æ string changed to formula or constant å
   i:=fx;
   repeat
    with sheetÆi,fyÅ do begin
     if overwritten in cellstatus then begin
      cellstatus:=cellstatus-ÆoverwrittenÅ;
      contents:='';
     end;
     if i<fxmax then i:=succ(i);
    end;
   until not (overwritten in sheetÆi,fyÅ.cellstatus) or (i=fxmax);
   with sheetÆfx,fyÅ do begin
    cellstatus:=ÆconstantÅ;
    if isform then cellstatus:=cellstatus+ÆformulaÅ;
    value:=result;
   end;
  end;
 end;

æ GETCELL finnaly starts here. this procedure uses all the above local å
æ procedures. first it initializes the temporaly variable "eline" with å
æ the last read character. it then depending on this character calls   å
æ GETFORMULA, GETTEXT, or EDITCELL. å

begin æ GETCELL å
 eline:=ch; errorposition:=0; abort:=false;
 newstat:=ÆÅ;
 if ch in Æ'0'..'9','+','-','.','(',')'Å then begin
  if ch ='(' then
   SKIFTTYPE(2)
  else
   SKIFTTYPE(1); 
  newstat:=ÆconstantÅ;
  if not (formula in sheetÆfx,fyÅ.cellstatus) then begin
   gotoxy(0,23); write(clreol);
   CLEARCELLS;
   GETFORMULA;
  end else begin
   FLASH(13,bell+'   Ret i formel J/N?  ',true);
   repeat
    ch:=UPCASE(KEY);
   until ch in Æ'J','N'Å;
   FJERNFLASH(13,23);
   if ch='J' then EDITCELL else abort:=true;
  end;
 end else begin
  if ch=esc then begin
   newstat:=(sheetÆfx,fyÅ.cellstatus)*Ætxt,constant,onscreenÅ;
   EDITCELL;
  end else begin
   if formula in sheetÆfx,fyÅ.cellstatus then begin
    FLASH(13,bell+'   Ret i formel J/N?  ',true);
    repeat
     ch:=UPCASE(KEY);
    until ch in Æ'J','N'Å;
    FJERNFLASH(13,23);
    if ch='J' then EDITCELL else abort:=true;
   end else begin
    SKIFTTYPE(0);
    newstat:=ÆtxtÅ;
    CLEARCELLS;
    GETTEXT;
   end;
  end;
 end;
 if not abort then begin
  if eline<>chr($FF) then UPDATECELLS;
  if onscreen in newstat then begin
   sheetÆfx,fyÅ.cellstatus:=sheetÆfx,fyÅ.cellstatus+ÆonscreenÅ;
  end;
  GOTOCELL(fx,fy);
  if autocalc and (constant in sheetÆfx,fyÅ.cellstatus) then RECALCULATE(true);
  if txt in newstat then begin
   gotoxy(2,fy);write(clreol);
   for i:='A' to fxmax do LEAVECELL(i,fy);
  end;
 end;
 FJERNFLASH(13,23);
 GOTOCELL(fx,fy);
end;

PROCEDURE GETINT(xp:byte; var i: integer; min,max: integer);
var
 err: integer;
 ch: char;
begin
 repeat
  eline:='';
  gotoxy(xp,23);
  repeat
   repeat
    ch:=KEY;
   until ch in Æ'0'..'9','-',return,venstreÅ;
   if ch<>return then begin
    if ch=venstre then begin
     if len(eline)>0 then delete(eline,len(eline),1);
     gotoxy(xp,23);write(clreol,eline); 
    end else begin
     write(ch); eline:=eline+ch;
     val(eline,i,err);
    end; 
   end;
  until (ch=return);
 until (i>=min) and (i<=max);
end;
«eof»
DataMuseum.dk

ICL Comet

⟦64d48e3a5⟧ TextFile

Derivation

TextFile
