home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / SPREDSHT / QSOLVE11.LBR / QS1.IZC / QS1.INC
Text File  |  2000-06-30  |  3KB  |  112 lines
  1. procedure CleanUp;
  2. begin
  3.   CAddr:=MemStart;
  4.   Message(' clean up in progress, please wait ... ');
  5.   for TC:=1 to 26 do
  6.     for TR:=1 to 99 do
  7.       CA[TC,TR]:=0;
  8.   while CAddr<MemPos do
  9.   begin
  10.     if Mem[CAddr+3]=9 then
  11.     begin
  12.       Temp:=CAddr+Mem[CAddr];
  13.       Move(Mem[Temp],Mem[CAddr],(MemPos-Temp)+1);
  14.       MemPos:=MemPos-(Temp-CAddr);
  15.     end else
  16.     begin
  17.       CA[Mem[CAddr+1],Mem[CAddr+2]]:=CAddr;
  18.       CAddr:=CAddr+Mem[CAddr];
  19.     end;
  20.   end;
  21.   FreeOfs:=0;
  22.   Message('');
  23. end;
  24.  
  25. procedure DelCell(C,R: integer);
  26. begin
  27.   CAddr:=CA[C,R];
  28.   if CAddr<>0 then
  29.   begin
  30.     FreeOfs:=FreeOfs+Mem[CAddr];
  31.     Mem[CAddr+3]:=9;
  32.     CA[C,R]:=0;
  33.   end;
  34. end;
  35.  
  36. procedure PutCell(C,R: integer);
  37. label
  38.   Exit;
  39. { uses:    CType, CText, CFor, CVal }
  40. begin
  41.   if CA[C,R]<>0 then DelCell(C,R);
  42.   Temp   :=MemPos;
  43.   CAddr  :=MemPos;
  44.   CA[C,R]:=MemPos;
  45.   if CType in [1,2]  then MemPos:=MemPos+Ord(CText[0])+5;
  46.   if CType in [3,13] then MemPos:=MemPos+Ord(CFor[0])+12;
  47.   if MemPos>MemEnd then
  48.   begin
  49.     MemPos :=Temp;
  50.     CleanUp;
  51.     Temp   :=MemPos;
  52.     CAddr  :=MemPos;
  53.     CA[C,R]:=MemPos;
  54.     if CType in [1,2]  then MemPos:=MemPos+Ord(CText[0])+5;
  55.     if CType in [3,13] then MemPos:=MemPos+Ord(CFor[0])+12;
  56.     if MemPos>MemEnd then
  57.     begin
  58.       Error(11);
  59.       CA[C,R]:=0;
  60.       MemPos:=Temp;
  61.       ShowCells;
  62.       goto Exit;
  63.     end;
  64.   end;
  65.   Mem[CAddr]  :=MemPos-CAddr;
  66.   Mem[CAddr+1]:=C;
  67.   Mem[CAddr+2]:=R;
  68.   Mem[CAddr+3]:=CType;
  69.   Case CType of
  70.     1,2 : Move(CText,Mem[CAddr+4],Ord(CText[0])+1);
  71.     3,13: begin
  72.             Move(CVal,Mem[CAddr+5 ],6);
  73.             Move(CFor,Mem[CAddr+11],Ord(CFor[0])+1);
  74.             Mem[CAddr+4]:=CForm;
  75.           end;
  76.   end;
  77. Exit:
  78. end;
  79.  
  80. procedure GetCell(C,R: integer);
  81. { returns: CAddr, CType, CText, CFor, CVal }
  82. begin
  83.   CAddr:=CA[C,R];
  84.   if CAddr<>0 then
  85.   begin
  86.     CType:=Mem[CAddr+3];
  87.     case CType of
  88.       1,2:  begin
  89.               Move(Mem[CAddr+4],CText,Mem[CAddr+4]+1);
  90.               CFor:='';
  91.               CForm:=0;
  92.               CVal:=0;
  93.             end;
  94.       3,13: begin
  95.               Move(Mem[CAddr+5 ],CVal,6);
  96.               Move(Mem[CAddr+11],CFor,Mem[CAddr+11]+1);
  97.               CForm:=Mem[CAddr+4];
  98.               CText:='';
  99.             end;
  100.     end;
  101.   end;
  102.   if (CAddr=0) or (CType=0) then
  103.   begin
  104.     CText:='';
  105.     CFor :='';
  106.     CForm:=0;
  107.     CType:=0;
  108.     CVal :=0;
  109.   end;
  110. end;
  111.  
  112.