home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / Chip_1997-10_cd.bin / ctenari / cisloe / cisloe.pas < prev    next >
Pascal/Delphi Source File  |  1997-03-06  |  7KB  |  255 lines
  1. program CisloE;
  2. {$S-,r-}
  3. uses
  4.   Opcrt,
  5.   OpString,
  6.   Opdate,
  7.   Dos;
  8.  
  9. Const
  10.   Max : LongInt=500;
  11. type
  12.   PX=array[1..65000] OF Byte;
  13.  
  14.   ArPtr=^PX;
  15.  
  16.   RecA= record
  17.           Zac:  LongInt;
  18.           Kon:  LongInt;
  19.           Tim:  Time;
  20.           Pole: PX;
  21.         end;
  22.  
  23.   RecB= record
  24.           C:    LongInt;
  25.           D:    LongInt;
  26.           Tim:  Time;
  27.           Pole: PX;
  28.         end;
  29.  
  30. var
  31.   i:        LongInt;
  32.   ii:       Word;
  33.   AA:      ^RecA;
  34.   BB:      ^RecB;
  35.   A,B:      ArPtr;
  36.   zn:       Char;
  37.   zv:       LongInt;
  38.   Vysledek: Text;
  39.   WorkFile: File;
  40.   TimBeg:   Time;
  41.   TimEnd:   Time;
  42.   TimCel:   Time;
  43.   OldTim:   Time;
  44.   NewTim:   Time;
  45.   Hodiny:   Byte;
  46.   Minuty:   Byte;
  47.   Sekundy:  Byte;
  48.   CelSec:   Word;
  49.   Ch:       Char;
  50.   DI:       SearchRec;
  51.   WJmeno:   PathStr;
  52.   OldZac:   LongInt;
  53. begin
  54.   FindFirst('E*.WRK',Archive,DI);
  55.   if DosError=0
  56.     then WJmeno:=DI.Name
  57.     else begin
  58.            ClrScr;
  59.            GotoXY(1,1);
  60.            WriteLn('Zadejte pozadovany pocet mist cisla E');
  61.            WriteLn('Pocet mist by mel byt sudy, max. 130000');
  62.            Write('(cislo<=0 znaci konec): ');
  63.            ReadLn(Max);
  64.            if max=0 then exit;
  65.            if max>130000 then max:=130000;
  66.            Max:=Max div 2;
  67.            WJmeno:='';
  68.          end;
  69.   AA:=nil;
  70.   BB:=nil;
  71.   GetMem(AA,SizeOf(RecA));
  72.   GetMem(BB,SizeOf(RecB));
  73.   A:=@AA^.Pole;
  74.   B:=@BB^.Pole;
  75.   AA^.Kon:=Max;
  76.   for i:=1 to AA^.Kon do begin
  77.     A^[i]:=0;
  78.     B^[i]:=0;
  79.   end;
  80.   A^[1]:=5;
  81.   B^[1]:=25;
  82.   BB^.C:=3;
  83.   TimCel:=0;
  84.   AA^.Zac:=1;
  85.  
  86.   if WJmeno<>'' then begin
  87.     Assign(WorkFile,WJmeno);
  88.     {$i-} reset(WorkFile,SizeOf(RecA)); {$i+}
  89.     ii:=IoResult;
  90.     if ii<>0 then begin
  91.       WriteLn('chyba ',ii,' pri otvirani souboru ',WJmeno);
  92.       exit;
  93.     end;
  94.     BlockRead(WorkFile,AA^,1,ii);
  95.     if ii<>1 then begin
  96.       WriteLn('Chyba pri cteni souboru A ',WJmeno);
  97.       exit;
  98.     end;
  99.     BlockRead(WorkFile,BB^,1,ii);
  100.     if ii<>1 then begin
  101.       WriteLn('Chyba pri cteni souboru B ',WJmeno);
  102.       exit;
  103.     end;
  104.     Close(WorkFile);
  105.     TimCel:=AA^.Tim;
  106.   end;
  107.   ClrScr;
  108.   GotoXY(10,10);
  109.   TextColor(lightred+blink);
  110.   Write('P  O  C  I  T  A  M   !!');
  111.   TextColor(lightgreen);
  112.   GotoXY(1,13);
  113.   WriteLn('Program lze kdykoliv prerusit stiskem klavesy.');
  114.   WriteLn('Nekdy je treba chvilicku pockat nez se ulozi rozpracovana data.');
  115.   TimBeg:=CurrentTime;
  116.   TextColor(red);
  117.   TextBackground(Green);
  118.   GotoXY(2,1);
  119.   WriteLn('  V Y P O C E T   C I S L A    E    N A   ',2*AA^.Kon,'   M I S T.    (C) JiVe/''90  ');
  120.   TextColor(lightgreen);
  121.   TextBackground(Black);
  122.   GotoXY(1,5);
  123.   WriteLn('do tohoto spusteni program pracoval celkem ',
  124.           TimeToTimeString('HHh:mm:ss',AA^.Tim));
  125.   WriteLn('                nyni byl program spusten v ',
  126.   CurrentTimeString(' Hh:mm:ss'));
  127.   OldTim:=CurrentTime;
  128.   OldZac:=AA^.Zac*2;
  129.   CH:='*';
  130.   repeat
  131.     GotoXY(1,3);
  132.     WriteLn('              prave vypocitavany clen rady ',BB^.C:9);
  133.     WriteLn('  prvni nenulova pozice v pricitanem clenu ',2*AA^.Zac:9);
  134.     BB^.D:=0;
  135.     zv:=(AA^.Zac div 40)*40;
  136.     GotoXY(1,18);
  137.     WriteLn('pozice ',2*zv+1,' v prave pocitanem clenu');
  138.     WriteLn('');
  139.     for i:=0 to 39 do
  140.       if (i+zv)<=AA^.kon
  141.         then if A^[i+zv+1]<10
  142.                then Write('0',A^[i+zv+1])
  143.                else Write(A^[i+zv+1]);
  144.     GotoXY(1,21);
  145.     for i:=0 to 39 do
  146.       if (i+zv)<=AA^.Kon
  147.         then if B^[i+zv+1]<10
  148.                then Write('0',B^[i+zv+1])
  149.                else Write(B^[i+zv+1]:2);
  150.     GotoXY(1,22);
  151.     WriteLn('');
  152.     Write('pozice ',2*zv+1,' ve vyslednem cisle E');
  153.     GotoXY(1,7);
  154.     WriteLn('                                   nyni je ',
  155.             CurrentTimeString(' Hh:mm:ss'));
  156.     if (AA^.Zac*2-OldZac)>100 then begin
  157.       NewTim:=CurrentTime;
  158.       TimeDiff(NewTim,OldTim,Hodiny,Minuty,Sekundy);
  159.       CelSec:=Word(Minuty)*100+Word(Hodiny)*3600+Word(Sekundy);
  160.       WriteLn('       cas potrebny na vypocet 100 mist je ',
  161.               CelSec:9,' [sec] ',Ch);
  162.       OldTim:=NewTim;
  163.       if Ch='*'
  164.         then CH:='+'
  165.         else Ch:='*';
  166.       OldZac:=AA^.Zac*2;
  167.     end;
  168.     for i:=AA^.Zac to AA^.Kon do begin
  169.       BB^.D:=BB^.D*100+A^[i];
  170.       A^[i]:=(BB^.D div BB^.C);
  171.       BB^.D:=(BB^.D mod BB^.C);
  172.       inc(B^[i],A^[i]);
  173.     end;
  174.     i:=AA^.Kon;
  175.     while ((i>=AA^.Zac)or(B^[i]>99)) do begin
  176.       if B^[i]>99 then begin
  177.         B^[i-1]:=B^[i-1]+(B^[i] div 100);
  178.         B^[i]:=B^[i] mod 100;
  179.       end;
  180.       dec(i);
  181.     end;
  182.     while ((AA^.Zac<=AA^.Kon) and (A^[AA^.Zac]=0)) do inc(AA^.Zac);
  183.     inc(BB^.C);
  184.     if KeyPressed then begin
  185.       while KeyPressed do zn:=ReadKey;
  186.       TimEnd:=CurrentTime;
  187.       TimeDiff(TimEnd,TimBeg,Hodiny,Minuty,Sekundy);
  188.       TimCel:=IncTime(TimCel,Hodiny,Minuty,Sekundy);
  189.       AA^.Tim:=TimCel;
  190.       BB^.Tim:=TimCel;
  191.       ClrScr;
  192.       if WJmeno='' then
  193.         WJmeno:='E'+Long2Str(Max)+'.WRK';
  194.       Assign(WorkFile,WJmeno);
  195.       ReWrite(WorkFile,SizeOf(RecA));
  196.       BlockWrite(WorkFile,AA^,1);
  197.       BlockWrite(WorkFile,BB^,1);
  198.       Close(WorkFile);
  199.       WriteLn;
  200.       WriteLn;
  201.       WriteLn('>cislo E se pocita na ',AA^.Kon*2,' mist');
  202.       WriteLn;
  203.       WriteLn('>dosud bylo spocteno ',2*AA^.Zac,' mist cisla E ');
  204.       WriteLn;
  205.       WriteLn('>prave byl pocitan ',BB^.C-1,'. clen rady');
  206.       WriteLn;
  207.       TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
  208.       WriteLn('>zatim se pocitalo: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
  209.       WriteLn;
  210.       WriteLn('>mezivysledky jsou ulozeny v souboru ',WJmeno);
  211.       WriteLn;
  212.       WriteLn('program: RNDr. J. Ventluka, Piskova 1956, 155 00  Praha 5 - Stodulky');
  213.       Freemem(AA,SizeOf(RecA));
  214.       Freemem(BB,SizeOf(RecB));
  215.       halt;
  216.     end;
  217.   until AA^.Zac>AA^.Kon;
  218.   TimEnd:=CurrentTime;
  219.   TimeDiff(TimEnd,TimBeg,Hodiny,Minuty,Sekundy);
  220.   TimCel:=IncTime(TimCel,Hodiny,Minuty,Sekundy);
  221.   Assign(Vysledek,'E'+Long2Str(AA^.Kon*2)+'.Cis');
  222.   ReWrite(Vysledek);
  223.   for i:=1 to AA^.Kon do begin
  224.     if ((i mod 40)=1)and(i>1) then WriteLn(Vysledek);
  225.     Write(Vysledek,LeftPadCh(Long2Str(B^[i]),'0',2));
  226.   end;
  227.   WriteLn(Vysledek);
  228.   WriteLn(Vysledek,'>vypocet se provadel na ',AA^.Kon*2,' mist');
  229.   WriteLn(Vysledek,'>posledni pocitany clen rady: ',BB^.C-1);
  230.   TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
  231.   WriteLn(Vysledek,'>celkova doba vypoctu cinila: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
  232.   WriteLn(Vysledek);
  233.   WriteLn(Vysledek,'program: J. Ventluka, Piskova 1956, 155 00  Praha 5 - Stodulky');
  234.   Close(Vysledek);
  235.   ClrScr;
  236.   WriteLn;
  237.   WriteLn;
  238.   WriteLn('>cislo E bylo spocteno na ',AA^.Kon*2,' mist');
  239.   WriteLn;
  240.   WriteLn('>posledni pocitany clen rady byl : ',BB^.C-1);
  241.   WriteLn;
  242.   TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
  243.   WriteLn('>celkove se pocitalo: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
  244.   WriteLn;
  245.   WriteLn('>vysledek je ulozen v souboru E',AA^.Kon*2,'.CIS');
  246.   WriteLn;
  247.   WriteLn('program: J. Ventluka, Piskova 1956, 155 00  Praha 5 - Stodulky');
  248.   if WJmeno<>'' then begin
  249.     Assign(WorkFile,WJmeno);
  250.     {$I-} erase(WorkFile); {$I+}
  251.     i:=IoResult;
  252.   end;
  253.   Freemem(AA,SizeOf(RecA));
  254.   Freemem(BB,SizeOf(RecB));
  255. end.