Простая задача. Delphi.

[svobodys]

Определите в тексте слово, содержащее минимальное число согласных ( При решении определить процедуру, или функцию, определяющую число согласных с слове).

Помогите с решением.

[Манжосов Денис :)]

Сделать массив согласных букв. И проверять после через цикл.

[svobodys]

ДЕнис, могли бы вы помочь?
Просто я новечек в программировании.
код есть этой программы. Но тут много чего лишнего. В нем, программа работает с использованием БЛОКНОТА. А нужно, чтобы в в самом Делфи с помощью кнопок.

код:

program Project2;

{$APPTYPE CONSOLE}

uses
--SysUtils;
--var file1, file2 : text; {объявляем 2 переменные типа текстовый файл}
-----txt : array of array of string; {объявляем массив слов}
i,j : integer;
procedure MakeString (x : string; kol : integer); forward;{заполняет строку массива слов}
procedure FindMin (); forward; //процедура поиска слова с минимальнм количеством согласных
function KolSogl(s : string) : integer; forward; //возвращает количество согласных

procedure Readtxt ();
{считывает текст из файла}
var x : string; {переменная для считывания из файла строки}
i, n : integer;
begin
setlength(txt, 50); // зададим по началу длину массива в 50 строк
n:=0; {по началу 0 строк массива}

while not eof (file1) do begin
Readln(file1, x); {считываем с файла строку}
MakeString (x, n); //формируем n-ю строку массива слов
inc(n);
end;
setlength(txt, n+1); //изменяем длину массива строк
end;
{----------------------------------------------------}

procedure MakeString (x : string; kol : integer);
{заполняет строку массива слов}
var n, i : integer;
begin
setlength(txt[kol], 50); //допусти в строке 50 слов максимум
n:=0;
txt[kol,n]:=''; //по началу слово пустое
for i:=1 to length (x) do begin
if x[i]=' ' then begin //разделяем строку на слова
inc(n);
txt[kol,n]:='';
end
else txt[kol,n]:=txt[kol,n]+x[i];
end;
setlength(txt[kol], n+1); //устанавливаем новую длину равную количеству слов
end;

procedure FindMin ();
//процедура поиска слова с минимальнм количеством согласных
var i, j : integer;
min : string;
begin
min:=txt[0,0]; // допустим что у первого слова минимум согласных
for i:=0 to length (txt)-1 do begin
for j:=0 to length (txt[i])-1 do begin
if KolSogl(txt[i,j])<KolSogl(min) then // если у кагото слова меньше количество согласных
min:=txt[i,j]; // то минимум к нему приравниваем
end;
end;

// цикл записи в файл
for i:=0 to length (txt)-1 do begin
for j:=0 to length (txt[i])-1 do begin
if KolSogl(txt[i,j])=KolSogl(min) then // если у кагото слова меньше количество согласных
writeln (file2, 'Слово: ', txt[i,j], ' Количество согласных: ', KolSogl(min));
end;
end;

end; //------------------

function KolSogl(s : string) : integer;
//возвращает количество согласных
var i, j, kol : integer;
temp : string;
begin
kol:=0; //по началу 0 согласных
temp:='БбВвГгДдЖжЗзЙйКкЛлМмНнПпРрСсТтФфХхЦцЧчШшЩщЬ ьЪъ';
for i:=1 to length(s) do begin
for j:=1 to length (temp)do
if s[i]=temp[j] then begin // если текущий символ слова - найден в строке согласных
inc(kol); //увеличиваем число согласных
break; // выходим из цикла поиска
end;
end;
KolSogl:=kol;
end;

begin {Начало выполнения программы}
try {пытаемся открыть файлы}
AssignFile(file1, 'input.txt');
AssignFile(file2, 'output.txt'); {переменные с входным и выходным файлом}
Reset(file1); {открытия file1 для чтения}
Rewrite (file2); {открытия file1 для записи}
Readtxt(); //вызов процедуры чтения текста из файла
FindMin(); // найти минимум согласных
finally
Close(file1);
Close(file2); {закрываем файлы}
writeln('Press any key to exit');
readln;
end;
end.

[Stilet]

Могу предложить вот такой вариант:

procedure TForm1.Button1Click(Sender: TObject);
var r,sl,s:string;max,k,i:integer;begin
  s:=Edit1.Text ;max:=0;k:=0;s:=s+' '; r:='';
 for i:=1 to length(s) do begin
   if s[i]<>' ' then begin
      sl:=sl+s[i];
      if s[i] in ['а','и','е','о','у'] then inc(k);
   end else begin
    if k>max then begin max:=k; r:=sl; end;
    k:=0;sl:='';
   end;
 end;
 caption:=r;
end;