home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / programs / spredsht / qsolve11.lbr / QS6.IZC / QS6.INC
Text File  |  1987-04-26  |  4KB  |  226 lines
  1.  
  2. procedure SetWidth;
  3. label
  4.   Exit;
  5. var
  6.   C,W,L: integer;
  7. begin
  8.   gotoxy(1,24);
  9.   clreol;
  10.   CurOn;
  11.   UlCur;
  12.   write('global Y/N ? ');
  13.   repeat read(kbd,Ch); Ch:=Upcase(Ch); until Ch in ['Y','N',#13];
  14.   if Ch='Y' then
  15.   begin
  16.     repeat
  17.       write(#13);
  18.       clreol;
  19.       W:=-999;
  20.       write('what''s the cell''s width (1 to 77) ? ');
  21.       read(W);
  22.       if W=-999 then goto Exit;
  23.     until W in [1..77];
  24.     for L:=1 to 26 do CWidth[L]:=W;
  25.   end;
  26.   if Ch='N' then
  27.   begin
  28.     repeat
  29.       write(#13);
  30.       clreol;
  31.       Ch:=#255;
  32.       write('what col. (A to Z) ? ');
  33.       read(kbd,Ch);
  34.       if Ch=#255 then goto Exit;
  35.       C:=Ord(Ch)-64;
  36.     until C in [1..26];
  37.     repeat
  38.       write(#13);
  39.       clreol;
  40.       W:=-999;
  41.       write('what''s the cell''s width (1 to 77) ? ');
  42.       read(W);
  43.       if W=-999 then goto Exit;
  44.     until W in [1..77];
  45.     CWidth[C]:=W;
  46.   end;
  47.   Col:=CC;
  48.   Row:=CR;
  49. Exit:
  50.   CurOff;
  51.   gotoxy(1,24);
  52.   clreol;
  53.   ShowBorder;
  54.   ShowCells;
  55. end;
  56.  
  57. procedure MoveToCell;
  58. label
  59.   Exit;
  60. var
  61.   S:   str5;
  62.   R,C: integer;
  63. begin
  64.   CurOn;
  65.   UlCur;
  66.   repeat
  67.     gotoxy(1,24);
  68.     clreol;
  69.     S:='';
  70.     write('move to what row & col ? ');
  71.     read(S);
  72.     if S='' then goto Exit;
  73.     StrRC(S,C,R);
  74.   until (C in [1..26]) and (R in [1..99]);
  75.   Col:=C;
  76.   Row:=R;
  77.   CC:=C;
  78.   CR:=R;
  79.   ShowBorder;
  80.   ShowCells;
  81. Exit:
  82.   gotoxy(1,24);
  83.   clreol;
  84.   CurOff;
  85. end;
  86.  
  87. procedure WriteSheet;
  88. label
  89.   Start,Exit;
  90. var
  91.   FileName:          str14;
  92.   F:         file of byte;
  93.   B:                 byte;
  94.   C,R,L:             integer;
  95. begin
  96.   CurOn;
  97.   UlCur;
  98. Start:
  99.   gotoxy(1,24);
  100.   clreol;
  101.   FileName:='';
  102.   write('file''s name ? ');
  103.   read(FileName);
  104.   if FileName='' then goto Exit;
  105.   Temp:=Pos('.',FileName);
  106.   if Temp>0 then FileName:=Copy(FileName,1,Pred(Temp));
  107.   FileName:=FileName+'.QSS';
  108.   if Exist(FileName) then
  109.   begin
  110.     write(#13);
  111.     clreol;
  112.     LowVideo;
  113.     write('file exists, erase (Y/N) ? ');
  114.     LowVideo ;
  115.     repeat read(kbd,Ch); Ch:=Upcase(Ch); until Ch in ['Y','N'];
  116.     write(#13);
  117.     clreol;
  118.     if Ch='N' then goto Start;
  119.   end;
  120.   Assign(F,FileName);
  121.   ReWrite(F);
  122.   B:=$FF;
  123.   write(F,B);
  124.   for L:=1 to 26 do write(F,CWidth[L]);
  125.   CAddr:=MemStart;
  126.   {$I-}
  127.   while CAddr<MemPos do
  128.   begin
  129.     if Mem[CAddr+3]<>9 then
  130.     begin
  131.       Temp:=Pred(CAddr+Mem[CAddr]);
  132.       for L:=CAddr to Temp do
  133.       begin
  134.         write(F,Mem[L]);
  135.         if IOResult<>0 then
  136.         begin
  137.           Error(91);
  138.           close(F);
  139.           erase(F);
  140.           goto Exit;
  141.         end;
  142.       end;
  143.     end;
  144.     CAddr:=CAddr+Mem[CAddr];
  145.   end;
  146.   close(F);
  147.   Exit:
  148.   write(#13);
  149.   clreol;
  150. end;
  151.  
  152. procedure ReadSheet;
  153. label
  154.   Start,Exit;
  155. var
  156.   FileName:          str14;
  157.   F:         file of byte;
  158.   B:                 byte;
  159.   C,R,TE,TB,T,L:     integer;
  160. begin
  161.   CurOn;
  162.   UlCur;
  163. Start:
  164.   gotoxy(1,24);
  165.   clreol;
  166.   write('erase current sheet <Y>/N ? ');
  167.   repeat read(kbd,Ch); Ch:=Upcase(Ch); until Ch in ['Y','N',#13];
  168.   if Ch<>'N' then
  169.   begin
  170.     MemPos:=MemStart;
  171.     FreeOfs:=0;
  172.     for C:=1 to 26 do
  173.       for R:=1 to 99 do
  174.         CA[C,R]:=0;
  175.     ShowCells;
  176.     ShowBorder;
  177.   end else CleanUp;
  178.   gotoxy(1,24);
  179.   clreol;
  180.   FileName:='';
  181.   write('file''s name ? ');
  182.   read(FileName);
  183.   if FileName='' then goto Exit;
  184.   Temp:=Pos('.',FileName);
  185.   if Temp>0 then FileName:=Copy(FileName,1,Pred(Temp));
  186.   FileName:=FileName+'.QSS';
  187.   if not Exist(FileName) then
  188.   begin
  189.     Error(93);
  190.     goto Start;
  191.   end;
  192.   Assign(F,FileName);
  193.   Reset(F);
  194.   read(F,B);
  195.   if B=255 then
  196.     for L:=1 to 26 do read(F,CWidth[L]) else Reset(F);
  197.   Temp:=MemPos;
  198.   while not Eof(F) do
  199.   begin
  200.     read(F,Mem[MemPos]);
  201.     TB:=Succ(MemPos);
  202.     TE:=(Mem[MemPos]+TB)-2;
  203.     if TE>MemEnd then
  204.     begin
  205.       close(F);
  206.       Error(11);
  207.       MemPos:=Temp;
  208.       goto Exit;
  209.     end;
  210.     for MemPos:=TB to TE do
  211.       read(F,Mem[MemPos]);
  212.     if (LastCalc=1) and (Mem[TB+3]=3)  then Mem[TB+3]:=13;
  213.     if (LastCalc=0) and (Mem[TB+3]=13) then Mem[TB+3]:=3;
  214.     DelCell(Mem[TB],Mem[TB+1]);
  215.     CA[Mem[TB],Mem[TB+1]]:=Pred(TB);
  216.     MemPos:=Succ(MemPos);
  217.   end;
  218.   close(F);
  219.   LookUpCells;
  220.   ShowCells;
  221.   ShowBorder;
  222. Exit:
  223.   write(#13);
  224.   clreol;
  225. end;
  226.