Удаление слов, нужно удалить слова Опции

[-Марина-]

Помогите! Нужна процедура, которая бы удаляла из текста слова, содержащие две или более разные гласные буквы.
P.S. Текст файлового типа и слова в нём уже разделены пробелами.

[-Марина-]

мне никто не поможет?

[klem4]

вот тебе пример для одной строки:

uses crt;

function CheckWord(const word: string): boolean;
const
  volwes = 'eyuioa';
var
  i, p: byte;
  ok: boolean;
begin
  i := 1;
  ok := true;

  while (i <= 6) and ok do begin
    p := pos(volwes[i], word);

    if p > 0 then
     ok := pos(volwes[i], copy(word, p + 1, 255)) = 0;

    if ok then inc(i);
  end;

  CheckWord := i > 6;
end;

procedure ReformString(var s: string);
var
  i, start: byte;
begin
  i := 1;
  while i <= length(s) do begin

    while (i <= length(s)) and (s[i] = ' ') do
      inc(i);

    if i <= length(s) then begin

      start := i;
      while (i <= length(s)) and (s[i] <> ' ') do
        inc(i);

      if not CheckWord(copy(s, start, i - start)) then begin
        delete(s, start, i - start + 1);
        i := start;
      end;

    end;
  end;
end;

var
  s: string;

begin
  clrscr;
  s := 'qwerty eqqqe fio fioi eyuioa!';
  writeln('"' + s, '"');
  ReformString(s);
  writeln('"' + s, '"');
  readln;
end.

[-Марина-]

[quote]ok := pos(volwes[i], copy(word, p + 1, 255)) = 0;

Где volwes[i] паскаль пишет, что Invalid qualifier. Что делать?

[klem4]

const
  volwes: string = 'eyuioa';

Сообщение отредактировано: klem4 - 25.04.2008 18:33

[-Марина-]

А как применить эту прогрмамму ко всему тексту, а не только к одной строке?

[klem4]

Читаешь входной файл построчно, применяешь к очередной прочитанной строке процедуру ReformString и пишешь измененную строку в выходной файл.

[volvo]

Может быть выгоднее читать посимвольно из файла, и уже во время составления слова подсчитывать число разных гласных в нем:

const
  vowels = ['A','a', 'E','e', 'I','i', 'O','o', 'U','u'];

var
  fin, fout: text;

  one_word: string;
  ch: char;
  count: integer;
  already: set of char;


begin
  assign(fin, 'in.txt'); reset(fin);
  assign(fout, 'out.txt'); rewrite(fout);

  while not eof(fin) do begin

    one_word := '';
    count := 0; already := [];

    repeat
      read(fin, ch);

      if ch = ' ' then begin

        if count < 2 then write(fout, one_word + ch);

        one_word := '';
        count := 0; already := [];

      end
      else begin
        one_word := one_word + ch;
        if (ch in vowels) and not (ch in already) then begin
          include(already, ch);
          inc(count);
        end;
      end;

    until eoln(fin);

    if (one_word <> '') and (count < 2) then
      write(fout, one_word);

    writeln(fout);
    readln(fin);

  end;

  close(fout);
  close(fin);
end.