Показать сообщение отдельно
Старый 24.02.2013, 13:45   #2 (permalink)
interacia
Member
 
Регистрация: 29.01.2013
Сообщений: 91
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 565
По умолчанию

Код:
program faile1;
type
bukva = set of char;
var
glas:bukva;
soglas:bukva;
S1,S2,S3: String;
// функция преобразования строки
function fun(S:string): string;
var
temp:string; // формирование новой строки
n:  integer; // счетчик для новой строки
ud: integer; // количество признаки для пропуска буквы
i:  integer;
begin
temp:=''; // начальное значение
// первый символ строки
if S[1] in glas then begin ud:=1; end
else begin ud:=0;end;
n:=1;
temp[0]:=S[0];
for i:=1 to length(S) do // проход по строке
begin
// первое условие начало слова
if ((S[i-1]=' ')and(S[i] in glas)) then  begin ud:=1;end; // начало слова
if ((ud=1) and (S[i] in soglas)) then begin ud:=2; end //первая согласная
else if ((ud=2) and (S[i] in soglas)) then // вторая согласная
     begin ud:=0;
     continue; // перескок через вторую гласную в слове
      end;
if S[i]=' ' then ud:=0; // конец слова
temp[n]:=S[i]; // заполнение строки
inc(n);
end;
fun:=temp;
end;
begin
// множество гласных букв
glas:=['й','Й','У','у','е','Е','ы','а','Ы','А','я','Я','э','Э','О','о','и','ь','ю','ъ','И','Ь','Ю','Ъ','ё','Ё'];
// множество согласных букв
soglas:=['ц','т','б','Б','Т','М','м','Ч','С','с','ч','Ж','ж','Ц','Д','к','н','д','К','Н','г','Г','ш','Ш','Л','щ','Щ','з','З','х','Х','ф','в','Ф','В','п','П','р','л','Р'];
writeln('Введите первую строку');
readln(S1);
writeln('Введите вторую строку');
readln(S2);
writeln('Введите третью строку');
readln(S3);

writeln('Ответ ');
write('1)');
writeln(fun(S1));
write('2)');
writeln(fun(S2));
write('3)');
writeln(fun(S3));
end.
interacia вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070