Dze je subor www.TrSek.com/cover/benkovic/permutacie.pas

{ PERMUTACIE.PAS                         Copyright (c) Jan Benkovic }
{ Program na simulaciu permutacii pre zadany pocet prvkov.          }
{                                                                   }
{ Datum:18.03.2002                             http://www.trsek.com }

uses crt;

var n,i,ia:byte;
    c2,c,c1:longint;
    a:array[0..10] of char;
    as:array[0..10] of char;
    ac:array[0..10] of byte;
    s,ch,s1:string;
    code,poc:integer;
    t:text;

begin
clrscr;
assign(t,'Permut.txt');
rewrite(t);
writeln(t,'Permutacie');

writeln('Program na simulaciu permutacii');
writeln('Zadaj pocet prvkov');
readln(n);

c1:=0; c:=1;
for i:= n downto 1 do
  begin
    c1:=i*c+c1;
    c:=10*c;                   {urcenie zaciatku napr 12345e}
  end;
writeln(c1);

c2:=0; c:=1;
for i:= 1 to n do
  begin
    c2:=i*c+c2;                {urcenie konca napr 54321}
    c:=10*c;
    a[i]:=char(64+i);          {ABCDE.....}
  end;
writeln(c2);

repeat

  s:='';
  s1:='';
  poc:=0;
  str(c1,s);                   {cislo->retazca   napr 12345 -> '12345' }

  for i:= 1 to n do
   begin                       {postupne nacitavanie jed cislic}
     ch:=copy(s,i,1);          {string->cislo napr '1' -> 1 }
     val(ch,ac[i],code);
     s1:=concat(s1,a[ac[i]]);  {spajanie podla cislic z povodneho ABCD...}

     if (ac[i]>n) or (ac[i]<=0) then
        poc:=1                 {vylucenie 0 a cisel >ako si zadal}
   end;
  c1:=c1+9;

  for i:= 1 to n do
   begin
     ia:=i+1;
     while ia<=n do
      begin
       if ac[i]=ac[ia] then poc:=1;       {vylucenie opakujucich sa cisel}
       inc(ia);
     end;
   end;

  if poc<>1 then
     writeln(t,s1,' ');
                                             {hotovo}
until c1>c2;

close(t);
writeln('Koniec - stlac enter');
readkey;
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com