Найти в тексте слова с нечетной длиной, в которых первая, средняя и последняя буквы — гласные, записать их заглавными буквами и указать после каждого такого слова в скобках найденные буквы — Pascal(Паскаль)

В текстовом файле input.txt записан русский текст. Найти в тексте слова с нечетной длиной (не менее 3), в которых первая, средняя и последняя буквы — гласные, записать их заглавными буквами и указать после каждого такого слова в скобках найденные буквы. Полученный текст записать в файл output.txt. Весь текст, кроме найденных слов, должен остаться неизменным, включая и знаки препинания

Program PascalGuru;

var
  s: string;
  f, t: text;

  { ----------------------------------------------- }
function preobr(s: string): string;
var
  i, j, p, n, sered: integer;
  gl, zp, slovo: string;
  m: array [1 .. 80] of string;
begin
  zp := '!?*,.'; { все знаки препинания }
  gl := 'аоуыэяеёюи';
  { начало разбиения предложения на слова }
  p := pos(' ', s);
  i := 0;
  repeat
    inc(i);
    slovo := copy(s, 1, p - 1);
    m[i] := slovo;
    delete(s, 1, p);
    p := pos(' ', s);
  until p = 0;
  n := i + 1;
  m[n] := s; { массив со словами }
  { --конец разбиения предложения на слова }

  for i := 1 to n do { проход по массиву слов строки }
  begin
    s := m[i];
    { "p" - будет переменной содержащей ДЛИНУ слова }
    if pos(s[length(s)], zp) <> 0 then
      p := length(s) - 1
    else
      p := length(s); { если есть знак препинания - не учитываем его }
    sered := (p div 2) + 1;
    if (not odd(p)) or (p < 3) then
      continue; { не подходит! длина ЧЁТНАЯ - или длина<3 }
    if pos(s[1], gl) = 0 then
      continue; { не подходит! первая буква НЕ гласная }
    if pos(s[sered], gl) = 0 then
      continue; { не подходит! средняя буква НЕ гласная }
    if pos(s[p], gl) = 0 then
      continue; { не подходит! последняя буква НЕ гласная }

    s[1] := UpCase(s[1]);
    s[sered] := UpCase(s[sered]);
    s[p] := UpCase(s[p]);

    m[i] := s + '(' + s[1] + ',' + s[sered] + ',' + s[p] + ')';

  end;
  { --- конец преобразования строки }

  s := ''; { запишем всю строку(обновлённую) сначала }
  for i := 1 to n do
    s := s + m[i] + ' ';

  preobr := s;
end;
{ ----------------------------------------------- }

begin
  assign(f, 'input.txt');
  reset(f);
  assign(t, 'output.txt');
  rewrite(t);

  while not eof(f) do
  begin
    readln(f, s);
    writeln(t, preobr(s));
  end;

  writeln('Файл успешно записан...');

  close(f);
  close(t);
  readln;

end.

Leave a Comment

13 − 8 =