PROGRAM pitau;{1000 Stellen von Pi}
 Uses Crt,Dos;Const n=1001;
 Var  i,j,k:integer;c,d,q,u,x:word;
      a    :array[1..n+1] of word;
procedure divi(y:word);
begin
 c:=0;for j:=1 to n+1 do
 begin x:=a[j]+c;q:=x div y;a[j]:=q;
 d:=x-y*q;c:=10*d;end;
end;
procedure mult(y:word);
begin
 for j:=1 to n+1 do a[j]:=y*a[j];
 for j:=n+1 downto 2 do
 begin u:=a[j] div 10;a[j-1]:=a[j-1]+u;
 a[j]:=a[j] mod 10;end;
end;
Begin
 clrscr;k:=trunc(n*ln(10)/ln(4));
 for i:=k downto 1 do begin divi(8);
 divi(i);mult(2*i-1);divi(2*i+1);
 mult(2*i-1);a[1]:=a[1]+3;end;write(' ');
 for i:=1 to n do begin write(a[i]);
 if i=1 then write('.');if (i mod 6=0) then
 write(' ');if wherex=80 then write('   ');end;
 write('... Zurueck zum Programm mit der Leertaste.');
 repeat until keypressed;
End.


























</XMP></BODY></HTML>