Помогите с Паскалем Часть 3

[LIARH]

Задача 4.

Условие задачи:

Из заданной строки удалить слово, содержащее наименьшее число гласных.



Программа:

PROGRAM Strings; {заголовок программы}

USES Crt, {Подключение модуля, содержащего процедуры ClrScr и ReadKey}
UnitStr;

VAR str, tStr: String;
n: Integer;
tSet: set of Char;
wrd: String; {под слова}
i, p: Integer;

BEGIN
ClrScr; {процедура очистки экрана}

ReadStr(str); {считываю строку из файла}
tStr := str;

while FindWord(tStr, wrd) do
begin
if (wrd[1] in Vowel) and (wrd[Length(wrd)] in Consonantal) then
begin
p := Pos(wrd, str);
for i := 1 to Length(wrd) do
if wrd[i] in Consonantal then
if wrd[i] in Capitals then wrd[i] := ChangeRegister(wrd[i]);
Delete(str, p, Length(wrd));
Insert(wrd, str, p);
end; {if..then}
Delete(tStr, Pos(wrd,tStr), Length(wrd));
end; {while}

WriteLn('Результат:');
WriteLn(str);

ReadKey; {процедура ожидания нажатия клавиши (чтобы можно было посмотреть результат)}
END.

Подключение модуля:

UNIT UnitStr;

INTERFACE

Const Capitals = ['А'..'Я'];
Vowel = ['А','Е','Ё','И','О','У','Ы','Э','Ю' ,'Я',
'a','е','ё','и','о','у','ы','э','ю' ,'я'];
Consonantal = ['Б','В','Г','Д','Ж','З','Й','К','Л' ,'М','Н','П','Р','С','Т','Ф','Х','Ц ','Ч','Ш','Щ','Ъ','Ь',
'б','в','г','д','ж','з','й','к','л' ,'м','н','п','р','с','т','ф','х','ц ','ч','ш','щ','ъ','ь'];

Procedure ReadStr(var s: String);
Function FindWord(var s, w: String): Boolean; {функция поиска слова в строке}
Function ChangeRegister(ch: Char): Char;

IMPLEMENTATION

Procedure ReadStr(var s: String);
Var f: Text;
Begin
Assign(f, 'D:\Strings.txt');
Reset(f);
ReadLn(f, s);
WriteLn(s);
Close(f);
End; {ReadArr}

Function FindWord(var s, w: String): Boolean; {функция поиска слова в строке}
Var ok: Boolean;
Begin
ok := false;
while s[1] = ' ' do Delete(s, 1, 1); {удаляю ведущие пробелы}
if Length(s) <> 0 then
begin
if Pos(' ', s) <> 0 then w := Copy(s, 1, Pos(' ', s)-1) {если строка не пуста, то копирую первое слово}
else w := s;
ok := true;
end;
FindWord := ok;
End; {FindWord}

Function ChangeRegister(ch: Char): Char;
Begin
case Ord(ch) of
128..143: ch := Chr(Ord(ch)+32);
144..159: ch := Chr(Ord(ch)+80);
240: ch := Chr(Ord(ch)+1);
end; {case}
ChangeRegister := ch;
End; {ChangeRegister}

END.