{A ver si esto te ayuda }
program ardenarpalabras;
uses
crt;
var
palabras : array[1..80] of string[50];
texto : string;
cont : integer;
procedure entradatexto(var tex : string);
begin
clrscr;
write(' Texto : '); readln(tex);
end;
procedure tomapalabras(t : string);
var
pal : string[50];
r, z, i : integer;
begin
cont := 0;
r := 1;
z := 1;
fillchar(pal,sizeof(pal),0);
for i := 1 to length(t) do
if t[i] <> ' ' then
begin
pal[r] := upcase(t[i]);
pal[0] := chr(r);
r := r + 1;
end
else
begin
palabras[z] := copy(pal,1,length(pal));
z := z + 1;
fillchar(pal,sizeof(pal),0);
r := 1;
end;
if pal <> '0' then
palabras[z] := copy(pal,1,length(pal));
cont := z;
end;
procedure ordenaypresenta;
var
temp : string[50];
h, k : integer;
begin
for h := 1 to cont do
begin
for k := cont downto h do
begin
if length(palabras[h]) > length(palabras[k]) then
begin
temp := palabras[h];
palabras[h] := palabras[k];
palabras[k] := temp;
end;
end;
end;
writeln;
for k := 1 to cont do
writeln(' ',palabras[k]); writeln;
writeln(' Pulse Una Tecla'); readkey;
end;
begin
entradatexto(texto);
tomapalabras(texto);
ordenaypresenta;
end.
Crear cuenta