Exercice Classe

Program exercice;
Uses Wincrt;
Type
  mat = Array [1..15,1..15] Of Char;
Var
  n: Integer;
  t: mat;
  ch: String;
  f: Text;
Function alphanum (ch:String): Boolean;
Var
i:integer;
test:Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := Upcase(ch[i]) In ['A'..'Z','0'..'9'] ;
  Until (i=Length(ch)) Or (test=False);
    alphanum:=test;
End;
Procedure saisie (Var n:Integer;Var ch:String);
Var
  x: Integer;
Begin
  Repeat
    Write ('Saisir N: ');
    Readln (n);
  Until (3<n) And (n<15);
  Repeat
    Write ('Saisir la chaine: ');
    Readln (ch);
  Until (Length(ch)<=Sqr(n)) And (alphanum(ch));
  Repeat
    x := Random(27)+64;
    ch := ch+Chr(x);
  Until Length(ch)=Sqr(n);
End;

Procedure remplir_t (Var t:mat;ch:String;n:Integer);
Var
  i,j: Integer;
Begin
  For i:=1 To n Do
    For j:=1 To n Do
      t[i,j] := ch[(i*n)-(n-j)]; {relation mathématique utiliser compteur si trop difficile}
End;

Function tri (ch:String): String;
Var
  n,i: Integer;
  aux: Char;
Begin
  n := Length(ch);
  Repeat
    For i:=1 To n-1 Do
      If ch[i]>ch[i+1] Then
        Begin
          aux := ch[i];
          ch[i] := ch[i+1];
          ch[i+1] := aux;
        End;
    n := n-1;
  Until (n=0);
  tri := ch;
End;

Procedure traitement (Var f:Text;t:mat;n:Integer);
Var
  res: String;
  i,j: Integer;
Begin
  res := '';
  For i:=1 To n Do
    res := res+t[i,i];
  For i:=2 To n Do
    For j:=1 To i-1 Do
      res := res+t[i,j];
  For i:=1 To n-1 Do
    For j:=i+1 To n Do
      res := res+t[i,j];
  Rewrite (f);
  Repeat
    Writeln (f,tri(Copy(res,1,n)));
    Delete (res,1,n);
  Until (res='');
  Close (f);
End;
Begin
  saisie (n,ch);
  remplir_t(t,ch,n);
  Assign (f,'c:\bac\mots.txt');
  traitement (f,t,n);
End.