{Mira esto}
program cuantapalabras;
uses
crt;
type
string100 = string[100];
const
frases : array[1..4] of string = (
' elefante se balanceaba sobre la tela de una ara¤a.' +
' Como veia que no se rompia, fue a llamar otro elefante',
' elefantes se balanceaban sobre la tela de una ara¤a.' +
' Como veia que no se rompia, fue a llamar otro elefante',
' elefante se balanceaba sobre la tela de una ara¤a.' +
' Como veia que no se rompia, fue a llamar otro elefante',
' elefante se balanceaba sobre la tela de una ara¤a.' +
' Como veia que no se rompia, fue a llamar otro elefante');
var
texto : string100;
procedure imbierte_letras(tt : string100; var l : string100);
var
s, m, d, g, r : integer;
loo, temp, imbt : string100;
begin
g := 1;
s := 0;
for r := 1 to length(tt) do
begin
if tt[r] <> ' ' then
begin
imbt[g] := tt[r];
imbt[0] := chr(g);
g := g + 1;
s := s + 1;
end
else
begin
s := 0;
m := 1;
for d := length(imbt) downto 1 do
begin
temp[m] := imbt[d];
temp[0] := chr(m);
m := m + 1;
end;
loo := copy(temp,1,length(imbt));
insert(loo,l,length(l));
insert(' ',l,length(l) + 1);
m := 1;
g := 1;
imbt := ' ';
temp := ' ';
end;
end;
if s > 0 then
begin
m := 1;
for d := length(imbt) downto 1 do
begin
temp[m] := imbt[d];
temp[0] := chr(m);
m := m + 1;
end;
loo := copy(temp,1,length(imbt));
insert(loo,l,length(l));
insert(' ',l,length(l) + 1);
end;
end;
function codifica_frase(frase : string100) : string100;
const
ante = '_';
var
y, j : integer;
camb : string100;
begin
y := 1;
codifica_frase := ' ';
if frase[1] <> ' ' then
begin
frase[1] := upcase(frase[1]);
insert(ante,frase,1);
end;
for j := 1 to length(frase) do
if frase[j] = ' ' then
begin
frase[j + 1] := upcase(frase[j + 1]);
insert(ante,frase,j + 1);
end;
for j := 1 to length(frase) do
begin
if (frase[j] = 'a') or (frase[j] = 'A') then
begin
if frase[j] = 'a' then
frase[j] := 'u';
if frase[j] = 'A' then
frase[j] := 'U';
end
else
if (frase[j] = 'u') or (frase[j] = 'U') then
begin
if frase[j] = 'u' then
frase[j] := 'a';
if frase[j] = 'U' then
frase[j] := 'A';
end;
if (frase[j] = 'i') or (frase[j] = 'I') then
begin
if frase[j] = 'i' then
frase[j] := 'o';
if frase[j] = 'I' then
frase[j] := 'O';
end
else
if (frase[j] = 'o') or (frase[j] = 'O') then
begin
if frase[j] = 'o' then
frase[j] := 'i';
if frase[j] = 'O' then
frase[j] := 'I';
end;
end;
codifica_frase := copy(frase,1,length(frase));
imbierte_letras(frase,texto);
end;
function cuenta_palabras(cadena : string100; le : char) : integer;
var
h, d, i, cont : integer;
car : char;
cad : string100;
begin
cuenta_palabras := 0;
cont := 0;
cad := ' ';
d := 1;
h := 0;
for i := 1 to length(cadena) do
begin
if cadena[i] <> ' ' then
begin
cad[d] := cadena[i];
cad[0] := chr(d);
d := d + 1;
h := h + 1;
end
else
begin
if cad[1] = le then
begin
cont := cont + 1;
end;
cad := ' ';
d := 1;
h := 0;
end;
end;
if h > 0 then
cont := cont + 1;
cuenta_palabras := cont;
end;
procedure presenta_frase;
var
te : char;
begin
writeln;
writeln(' Elija Numero De Frase A Presentar');
writeln;
writeln(' Frase [1]');
writeln(' Frase [2]');
writeln(' Frase [3]');
writeln(' Frase [4]');
writeln;
repeat
te := readkey;
until te in['1'..'4'];
writeln(' La Frase ES');
writeln;
case te of
'1' : writeln(frases[1]);
'2' : writeln(frases[2]);
'3' : writeln(frases[3]);
'4' : writeln(frases[4]);
end;
writeln;
writeln(' Pulse Una Tecla');
readkey;
end;
procedure menu;
var
sal : boolean;
ts : char;
begin
sal := false;
repeat
clrscr;
writeln(' **** Menu Jeneral ****');
writeln(' //////////////////////');
writeln;
writeln(' 1 : Cuenta Palabres');
writeln(' 2 : Presenta Frase');
writeln(' 3 : Codifica Frase');
writeln(' 4 : Salir');
writeln;
writeln(' >>>> Elija Opcion <<<<');
repeat
ts := readkey;
until ts in['1'..'4'];
clrscr;
case ts of
'1' : begin
writeln(' Roman tenia un Ramo de Rosas La Letra Es R');
writeln;
writeln(' Las Palabras Son : ',cuenta_palabras('Roman tenia un Ramo de Rosas','R'));
writeln;
writeln(' Pulse Una Tecla');
readkey;
end;
'2' : presenta_frase;
'3' : begin
writeln(' La Frase Es = roman tenia un ramo de rosas');
writeln;
writeln(' ',codifica_frase('roman tenia un ramo de rosas'));
writeln;
writeln(' Final Queda = ',texto);
writeln;
writeln(' Pulse Una Tecla');
readkey;
end;
'4' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.