1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
| program app2;
uses wincrt;
type TAB=array [1..10] of string;
TAB1=array [1..10] of integer;
var n, i, p, x, y:integer;
T:TAB;
R:TAB1;
procedure saisie (var n:integer; var T:TAB);
begin
repeat
write ('saisir la taille du tableau ==>');
readln (n);
until (n>3) and (n<10);
writeln;
for i:=1 to n do
repeat
write ('T[', i, ']=');
readln (T[i]);
until (T[i][1] in ['A'..'Z']);
end;
procedure ranger (n: integer; var T:TAB; var R:TAB1);
function posvoy (i:integer; n:integer; T:TAB):integer;
var j:integer;
q:boolean;
v:string;
begin
j:= 0;
repeat
j:=j + 1;
v:=T[i];
q:= false;
case v[j] of
'a', 'e', 'i', 'u', 'y', 'o', 'A', 'E', 'O', 'I', 'Y', 'U':
begin
p:=j;
q:= true;
end;
end;
until (q = true);
posvoy:= p;
end;
begin
for i:=1 to n do
begin
p:= posvoy (i, n, T);
R[i]:= p;
writeln (R[i]);
end;
end;
procedure tri (n:integer;var R:TAB1);
var y:boolean;
procedure permute (var x, y:integer);
var z:integer;
begin
z:=x; x:=y; y:=z;
end;
begin
y:=false;
repeat
for i:=1 to n-1 do
begin
if R[i]>R[i+1] then
begin
permute (R[i], R[i+1]); y:=true;
end;
end;
n:= n-1;
until (y=false) or (n=1);
end;
procedure affiche (R:TAB1; n:integer);
begin
for i:=1 to n do
write (R[i]:5);
end;
BEGIN
saisie (n, T);
ranger (n, T, R);
tri (n, R);
writeln;
affiche (R, n);
END. |
Partager