Удаление слов из текста

[Sazary]

А почитать в учебнике не можете? Или хотите, чтобы за вас написали?

[Gery]

Ох... это было бы идеально)
Но думаю, не реально...
так ведь!?

[Sazary]

Вы правильно думаете. Пробуйте сами. Ничего сложного там нет.
Будут вопросы - задавайте.

[Gery]

какая-то ерунда получается

var s,s1,s2,s3,a:string;
x,n,i:integer;
begin
writeln('vvedite tekst');
readln(s);
s:=' '+s;
i:=0;
a:='';
while i <= length(s) do begin
i:=i+1;
s1:=copy(s,i,1);
s2:=copy(s,i+1,1);
if s1=' ' then if ((s2='a') or (s2='e') or (s2='u') or (s2='i')
or (s2='o') then begin
repeat
i:=i+1;
s3:=copy(s,i,1)
until s3<>' ';
i:=i+1
end
else a:=a+s1
end;
s1:=copy(a,1,1);
if s1=' ' then delete(a,1,1);
writeln(a);
readln
end.

[Sazary]

Вообще для типа стринг можно делать также, как и для чара.

uses crt;
var s,s1,s2,s3,a:string;
x,n,i:integer;
mn : set of char;

begin
writeln('vvedite tekst');
readln(s);
i:=1;
a:='';
mn := ['a','e','i','o','y','u'];
while i <= length(s) do
 begin
 while (s[i]=' ') and (i<=length(s)) do
  begin
  a := a + s[i];
  inc(i);
  end;
 if s[i] in mn then
  while (s[i]<>' ') and (i<=length(s)) do
   inc(i)
 else
  while (s[i]<>' ') and (i<=length(s)) do
   begin
   a := a + s[i];
   inc(i);
   end;
 end;

writeln(a);
readln
end.

[Gery]

Сообщение от Sazary

В общем, вот:

var text,m:array [1..50] of char;
glasnie:set of char;
i,j,k:integer;

begin
glasnie:=['A','a','O','o','E','e','U','u','I' ,'i'];
writeln ('введите текст');

i:=0;
repeat
 i:=i+1;
 read (text[i]);
until text[i]='.';

i := 1;
j := 0;

while text[i]<>'.' do
 begin
 while (text[i]=' ') and (text[i]<>'.') do
  begin
  inc(j);
  m[j] := text[i];
  inc(i);
  end;
 if text[i] in glasnie then
  while (text[i]<>' ') and (text[i]<>'.') do
   inc(i)
  else
   while (text[i]<>' ') and (text[i]<>'.') and (j<50) do
    begin
    inc(j);
    m[j] := text[i];
    inc(i);
    end;
 end;

 writeln;
for i:=1 to j do
 write(m[i]);
readln;
end.

а как сделать, чтобы удалялись лишние пробелы?

[Sazary]

Изучайте:

uses crt;
var s,s1,s2,s3,a:string;
x,n,i,k:integer;
mn : set of char;

begin
writeln('vvedite tekst');
readln(s);
i:=1;
a:='';
k := 1;
mn := ['a','e','i','o','y','u'];
while i <= length(s) do
 begin
 while (s[i]=' ') and (i<=length(s)) do
  inc(i);
 if s[i] in mn then
  while (s[i]<>' ') and (i<=length(s)) do
   inc(i)
 else
  while (s[i]<>' ') and (i<=length(s)) do
   begin
   a := a + s[i];
   inc(k);
   inc(i);
   end;
   if(length(a)>0) and (a[k-1]<>' ') then
    begin
    a := a + ' ';
    inc(k);
    end;
 end;

writeln(a);
readln
end.

[Gery]

Эм... с пробелами я все поняла.
Но мне хотелось, чтобы не было массива или множества из гласных.
А было 3 строки: входная, выходная и строка из гласных.

[Sazary]

Сообщение от Gery

Но мне хотелось, чтобы не было массива или множества из гласных.
А было 3 строки: входная, выходная и строка из гласных.

Тогда просто сделайте строку из гласных и вместо вот этого:

if s[i] in mn then

пробегайтесь по строке в цикле. Если найдено совпадение, то ..., если нет...

[Gery]

Что-то не так...

var
i,s,k:integer;
gl:string='aeiou';
R1,R2,f:string;

begin
writeln (f);
readln(f);
k:=pos(' ',f);
while s<=length(f) do
if f[s] in gl then
R1:=copy(f,1,k)
 else repeat s:=s+1 until f[s]<>'  ';
delete(f,1,k);
writeln(f);
readln
end.