[nav]

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

{найти в тексте слова, которые начинаются и окончиваются на одну букву и посчитать  их количество. Например-дано:акула, машина, торт, акула ответ:акула-2, торт-1} procedure TForm1.Button1Click(Sender: TObject); var BykvaEnd,BykvaHome:char; slovo:string;     count:array[1..100] of integer; poisk,k,g:integer; begin memo1.Color:=clred; memo2.Color:=clblue;  memo1.Font.Color:=clwhite; memo2.Font.Color:=clyellow;  slovo:=memo1.Lines.Text;  k:=1;  BykvaHome:=slovo[1]; BykvaEnd:=slovo[length(slovo)];  if BykvaEnd=' '  then BykvaEnd:=slovo[length(slovo)-1] {пропускаю пробелы, иначе ищу слово}  else if BykvaHome=BykvaEnd       then begin poisk:=pos(slovo,memo1.Lines.Text);{ищу повтор слова}                  count[k]:=count[k]+1 end       else begin k:=k+1; slovo:=memo1.lines.Text end;  for g=1 to k do memo2.Lines.Add(slovo+StrToint(count[g])) end;{procedure}

может я зря memo2 ввёл? Прога совсем не идёт

[Asinkrit]

Держи)
Для работы алгоритма, требуется мемо, листбокс и кнопка.

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

procedure TForm1.Button1Click(Sender: TObject); var   cnts:array of integer;   i,n:integer;   w:String; begin   w:='';   SetLength(cnts,0);   with ListBox1.Items do     begin     ListBox1.Clear;     BeginUpdate;     for i:=1 to Length(Memo1.Text) do       if Memo1.Text[i] in [' ',',','.',#10,#13] then         begin         if (Length(w)>1) and (w[1]=w[Length(w)]) then           begin           n:=IndexOf(w);           if n <> -1 then cnts[n]:=cnts[n]+1               else                 begin                 Add(w);                 SetLength(cnts,Length(cnts)+1);                 cnts[high(cnts)]:=1;                 end;           end;         w:='';         end           else w:=w+Memo1.Text[i];     for i:=Low(cnts) to high(cnts) do       Strings[i]:=Strings[i]+' : '+IntToStr(cnts[i]);     SetLength(cnts,0);     EndUpdate;     end; end;

[Страдалецъ]

Можно несколько попроще, если текст разбить по словам и слова запихать в TStringList, а там уже можно используя сортировку это сделать легко.

[nav]

Сообщение от Asinkrit

Держи)
Для работы алгоритма, требуется мемо, листбокс и кнопка.

спасибо, сделал. Только у меня выдает акула-1, но это я сам подумаю.
P.S.А круто я тему написал: "поикс"? Буквы перепутал!

[Asinkrit]

У меня он выдавал, как ты просил, смотри в чем ошибся..

[nav]

Сообщение от Asinkrit

У меня он выдавал, как ты просил, смотри в чем ошибся..

хорошо, разберусь

[iliasmalorum02]

Сообщение от Страдалецъ

Можно несколько попроще, если текст разбить по словам и слова запихать в TStringList, а там уже можно используя сортировку это сделать легко.

А и не надо ничего на слова разбивать! Просто перебираем строку как массив, и как только пробел найден, сравниваем букву после этого пробела с буквой перед первой после текущего пробела запятой.