Source :

Une manière de coder un texte consiste en l'opération suivante. On se fixe un entier n donné. On considère que le texte à coder est une chaîne de caractères. En commençant à partir du premier caractère, on divise le texte en blocs de longueur n² (nxn) caractères consécutifs. Si la longueur du texte n'est pas un multiple de n², on lui ajoute autant d'espaces qu'il en faut pour  que sa longueur devienne un multiple de n². Chaque bloc est divisé à son tour en n sous-blocs de longueur n caractères. En disposant ces sous-blocs l'un en dessous de l'autre, on obtient alors n colonnes. Chaque colonne, lue du haut vers le bas,  va donner une chaîne de n caractères. En rassemblant dans l'ordre toutes ces chaînes, on obtient une nouvelle chaîne qui sera le texte codé.

Exemple :

Pour n = 3 et le texte à coder ="Je vais à Tunis pour l'OTI"

La longueur de ce texte est égale à 26. On lui ajoute 1 espace pour que sa longueur devienne multiple de 9. La chaîne devient  "Je vais à Tunis pour l'OTI "

Sa longueur devient donc  27.

En appliquant les étapes ci-dessus évoquées, on obtient :

La chaîne codée sera :

                                     "Jvsea  ià n TipusoulTr'I O "

Écrire un programme qui saisit un entier naturel n tel que 2<n<9 et le texte à coder (une chaîne de caractères). Il fait sortir ensuite le texte codé.

Correction :

program codes;

uses wincrt;

Var  ch : string;

     nc : integer;

function coder(m : integer; ch_org:string):string;

var    i,j,k,l,d    : integer;

       p,db,nb_bloc : integer;

       ch_out       : string;

begin

l:=length(ch_org); d:=sqr(m)-(l mod sqr(m));

if d<>0 then

                  begin

                          For i:=1 to d do ch_org:=ch_org+' ';

                  end;

ch_out:=ch_org;

nb_bloc:=length(ch_org) div sqr(m);

p:=1;

For i:=1 to nb_bloc do

                        begin

                          db:=(i-1)*sqr(m) + 1;

                          for j:=0 to m-1 do

                               begin

                                      for k :=0 to m-1 do

                                         begin

                                           ch_out[p]:=ch_org[db+j+k*m];

                                           p:=p+1;

                                         end;

                               end;

                          end;

coder:=ch_out;

end;

procedure saisie(var m :integer; var txt_coder:string);

begin

   repeat

          write('Donner un entier entre 1 et 5 : '); readln(m);

   until m in [1..5];

   write('Saisir le texte ŕ coder : ');readln(txt_coder);

   writeln;

end;

begin

  saisie(nc,ch);

  writeln('le texte codé sera : ',coder(nc,ch));

end.