home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1997 October
/
Chip_1997-10_cd.bin
/
ctenari
/
cisloe
/
cisloe.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-06
|
7KB
|
255 lines
program CisloE;
{$S-,r-}
uses
Opcrt,
OpString,
Opdate,
Dos;
Const
Max : LongInt=500;
type
PX=array[1..65000] OF Byte;
ArPtr=^PX;
RecA= record
Zac: LongInt;
Kon: LongInt;
Tim: Time;
Pole: PX;
end;
RecB= record
C: LongInt;
D: LongInt;
Tim: Time;
Pole: PX;
end;
var
i: LongInt;
ii: Word;
AA: ^RecA;
BB: ^RecB;
A,B: ArPtr;
zn: Char;
zv: LongInt;
Vysledek: Text;
WorkFile: File;
TimBeg: Time;
TimEnd: Time;
TimCel: Time;
OldTim: Time;
NewTim: Time;
Hodiny: Byte;
Minuty: Byte;
Sekundy: Byte;
CelSec: Word;
Ch: Char;
DI: SearchRec;
WJmeno: PathStr;
OldZac: LongInt;
begin
FindFirst('E*.WRK',Archive,DI);
if DosError=0
then WJmeno:=DI.Name
else begin
ClrScr;
GotoXY(1,1);
WriteLn('Zadejte pozadovany pocet mist cisla E');
WriteLn('Pocet mist by mel byt sudy, max. 130000');
Write('(cislo<=0 znaci konec): ');
ReadLn(Max);
if max=0 then exit;
if max>130000 then max:=130000;
Max:=Max div 2;
WJmeno:='';
end;
AA:=nil;
BB:=nil;
GetMem(AA,SizeOf(RecA));
GetMem(BB,SizeOf(RecB));
A:=@AA^.Pole;
B:=@BB^.Pole;
AA^.Kon:=Max;
for i:=1 to AA^.Kon do begin
A^[i]:=0;
B^[i]:=0;
end;
A^[1]:=5;
B^[1]:=25;
BB^.C:=3;
TimCel:=0;
AA^.Zac:=1;
if WJmeno<>'' then begin
Assign(WorkFile,WJmeno);
{$i-} reset(WorkFile,SizeOf(RecA)); {$i+}
ii:=IoResult;
if ii<>0 then begin
WriteLn('chyba ',ii,' pri otvirani souboru ',WJmeno);
exit;
end;
BlockRead(WorkFile,AA^,1,ii);
if ii<>1 then begin
WriteLn('Chyba pri cteni souboru A ',WJmeno);
exit;
end;
BlockRead(WorkFile,BB^,1,ii);
if ii<>1 then begin
WriteLn('Chyba pri cteni souboru B ',WJmeno);
exit;
end;
Close(WorkFile);
TimCel:=AA^.Tim;
end;
ClrScr;
GotoXY(10,10);
TextColor(lightred+blink);
Write('P O C I T A M !!');
TextColor(lightgreen);
GotoXY(1,13);
WriteLn('Program lze kdykoliv prerusit stiskem klavesy.');
WriteLn('Nekdy je treba chvilicku pockat nez se ulozi rozpracovana data.');
TimBeg:=CurrentTime;
TextColor(red);
TextBackground(Green);
GotoXY(2,1);
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 ');
TextColor(lightgreen);
TextBackground(Black);
GotoXY(1,5);
WriteLn('do tohoto spusteni program pracoval celkem ',
TimeToTimeString('HHh:mm:ss',AA^.Tim));
WriteLn(' nyni byl program spusten v ',
CurrentTimeString(' Hh:mm:ss'));
OldTim:=CurrentTime;
OldZac:=AA^.Zac*2;
CH:='*';
repeat
GotoXY(1,3);
WriteLn(' prave vypocitavany clen rady ',BB^.C:9);
WriteLn(' prvni nenulova pozice v pricitanem clenu ',2*AA^.Zac:9);
BB^.D:=0;
zv:=(AA^.Zac div 40)*40;
GotoXY(1,18);
WriteLn('pozice ',2*zv+1,' v prave pocitanem clenu');
WriteLn('');
for i:=0 to 39 do
if (i+zv)<=AA^.kon
then if A^[i+zv+1]<10
then Write('0',A^[i+zv+1])
else Write(A^[i+zv+1]);
GotoXY(1,21);
for i:=0 to 39 do
if (i+zv)<=AA^.Kon
then if B^[i+zv+1]<10
then Write('0',B^[i+zv+1])
else Write(B^[i+zv+1]:2);
GotoXY(1,22);
WriteLn('');
Write('pozice ',2*zv+1,' ve vyslednem cisle E');
GotoXY(1,7);
WriteLn(' nyni je ',
CurrentTimeString(' Hh:mm:ss'));
if (AA^.Zac*2-OldZac)>100 then begin
NewTim:=CurrentTime;
TimeDiff(NewTim,OldTim,Hodiny,Minuty,Sekundy);
CelSec:=Word(Minuty)*100+Word(Hodiny)*3600+Word(Sekundy);
WriteLn(' cas potrebny na vypocet 100 mist je ',
CelSec:9,' [sec] ',Ch);
OldTim:=NewTim;
if Ch='*'
then CH:='+'
else Ch:='*';
OldZac:=AA^.Zac*2;
end;
for i:=AA^.Zac to AA^.Kon do begin
BB^.D:=BB^.D*100+A^[i];
A^[i]:=(BB^.D div BB^.C);
BB^.D:=(BB^.D mod BB^.C);
inc(B^[i],A^[i]);
end;
i:=AA^.Kon;
while ((i>=AA^.Zac)or(B^[i]>99)) do begin
if B^[i]>99 then begin
B^[i-1]:=B^[i-1]+(B^[i] div 100);
B^[i]:=B^[i] mod 100;
end;
dec(i);
end;
while ((AA^.Zac<=AA^.Kon) and (A^[AA^.Zac]=0)) do inc(AA^.Zac);
inc(BB^.C);
if KeyPressed then begin
while KeyPressed do zn:=ReadKey;
TimEnd:=CurrentTime;
TimeDiff(TimEnd,TimBeg,Hodiny,Minuty,Sekundy);
TimCel:=IncTime(TimCel,Hodiny,Minuty,Sekundy);
AA^.Tim:=TimCel;
BB^.Tim:=TimCel;
ClrScr;
if WJmeno='' then
WJmeno:='E'+Long2Str(Max)+'.WRK';
Assign(WorkFile,WJmeno);
ReWrite(WorkFile,SizeOf(RecA));
BlockWrite(WorkFile,AA^,1);
BlockWrite(WorkFile,BB^,1);
Close(WorkFile);
WriteLn;
WriteLn;
WriteLn('>cislo E se pocita na ',AA^.Kon*2,' mist');
WriteLn;
WriteLn('>dosud bylo spocteno ',2*AA^.Zac,' mist cisla E ');
WriteLn;
WriteLn('>prave byl pocitan ',BB^.C-1,'. clen rady');
WriteLn;
TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
WriteLn('>zatim se pocitalo: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
WriteLn;
WriteLn('>mezivysledky jsou ulozeny v souboru ',WJmeno);
WriteLn;
WriteLn('program: RNDr. J. Ventluka, Piskova 1956, 155 00 Praha 5 - Stodulky');
Freemem(AA,SizeOf(RecA));
Freemem(BB,SizeOf(RecB));
halt;
end;
until AA^.Zac>AA^.Kon;
TimEnd:=CurrentTime;
TimeDiff(TimEnd,TimBeg,Hodiny,Minuty,Sekundy);
TimCel:=IncTime(TimCel,Hodiny,Minuty,Sekundy);
Assign(Vysledek,'E'+Long2Str(AA^.Kon*2)+'.Cis');
ReWrite(Vysledek);
for i:=1 to AA^.Kon do begin
if ((i mod 40)=1)and(i>1) then WriteLn(Vysledek);
Write(Vysledek,LeftPadCh(Long2Str(B^[i]),'0',2));
end;
WriteLn(Vysledek);
WriteLn(Vysledek,'>vypocet se provadel na ',AA^.Kon*2,' mist');
WriteLn(Vysledek,'>posledni pocitany clen rady: ',BB^.C-1);
TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
WriteLn(Vysledek,'>celkova doba vypoctu cinila: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
WriteLn(Vysledek);
WriteLn(Vysledek,'program: J. Ventluka, Piskova 1956, 155 00 Praha 5 - Stodulky');
Close(Vysledek);
ClrScr;
WriteLn;
WriteLn;
WriteLn('>cislo E bylo spocteno na ',AA^.Kon*2,' mist');
WriteLn;
WriteLn('>posledni pocitany clen rady byl : ',BB^.C-1);
WriteLn;
TimeToHMS(TimCel,Hodiny,Minuty,Sekundy);
WriteLn('>celkove se pocitalo: ',Hodiny,'h ',Minuty,'m ',Sekundy,'s');
WriteLn;
WriteLn('>vysledek je ulozen v souboru E',AA^.Kon*2,'.CIS');
WriteLn;
WriteLn('program: J. Ventluka, Piskova 1956, 155 00 Praha 5 - Stodulky');
if WJmeno<>'' then begin
Assign(WorkFile,WJmeno);
{$I-} erase(WorkFile); {$I+}
i:=IoResult;
end;
Freemem(AA,SizeOf(RecA));
Freemem(BB,SizeOf(RecB));
end.