Solution d'un exercice!!

program dc2;
uses wincrt;
type fich1=file of integer;
     tab=array [1..30] of integer;
     matrice=array [1..20 , 1..20] of integer;
     
var f2:text;
    f3:text;
    f1:fich1;
    t:tab;
    mat:matrice;
    n,s,f,x:integer;


procedure creation(var f1:fich1;var f2:text;var f3:text);
begin
assign(f1,'c:\nombre\nombre.dat');
rewrite(f1);
assign(f2,'c:\nombre\nombre_modif.txt');
rewrite(f2);
assign(f3,'c:\nombre\pascal.txt');
rewrite(f3);
end;

procedure remplir(var f1:fich1);
var n:integer;
begin
reset(f1);
repeat
write('donner un entier: ');
read(n);
write(f1,n);
until(n<=0);
close(f1);
end;

procedure chargement (var t:tab;var f1:fich1;n:integer);
var i:integer;
begin
reset(f1);
for i:=1 to n do
write(f1,t[i]);
close(f1);
end;

procedure TriShell(n : integer ; var t : tab);
var
  p, k, i, j : integer;
begin
  p := 1;
  while (p < n) do p := 3 * p + 1; 
  while (p <> 1) do
  begin
    p := p div 3;
    for i := p+1 to n do
    begin
      k := t[i]; 
      j:= i;
      while (j > p) and (t[j - p] > k) do
      begin
        t[j] := t[j - p];
        j := j - p;
      end;
      t[j] := k;
    end;
  end;
end;


function somme (t:tab;n:integer):integer;
var i:integer;
begin
if n=0 then somme:=0
   else somme:=t[n]+somme(t,n-1);
{s:=0;
for i:=1 to n do
s:=s+t[i];
somme:=s;}
end;


function fact(x:integer):longint;
begin
if x=0 then fact:=1
       else fact:=x*fact(x-1);
end;


PROCEDURE Remplir_MAT (N: integer; VAR MAT : Matrice);
VAR i,j : Word ;
Begin
MAT [1,1] := 1 ;
MAT [2,1] := 1 ;
MAT [2,2] := 1 ;
For i := 3 To N Do
Begin
MAT [i, 1] := 1;
MAT [i, j] := 1;
For j := 2 To j-1 Do
Begin
MAT [i, j] := MAT [i-1, j] + MAT [i-1, j-1];
End ;
End ;
End ;

procedure remplir1(var f2:text;t:tab;n:integer;s:integer;f:longint);
var i:integer;

begin
reset(f2);
for i:=1 to n do
writeln(f2,t[i],' ');
writeln(f2,s);
writeln(f2,f);
close(f2);
end;

procedure remplir2(var f3:text;var f1:fich1;mat:matrice;x:integer);
var i,j :integer;
begin

reset(f3);
For i := 1 To x Do
Begin
WriteLn(f3,'') ;
For j := 1 To i Do
Write(f3,Mat [i, j]:2,' ') ;
End;
end;



begin

creation(f1,f2,f3);

remplir(f1);

reset(f1);

n:=filesize(f1);

chargement(t,f1,n);

TriShell(n,t);

s:=somme(t,n);

reset(f1);
read(f1,x);

f:=fact(x);

remplir1(f2,t,n,s,f);

remplir_mat(x,mat);

remplir2(f3,f1,mat,x);

end.