Показать сообщение отдельно
  #4  
Старый 21.06.2015, 20:32
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Доработка процедуры из первого поста, правда извнс, вероятно получился G-код
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
 i, m, r: integer;
 buf: array[0..1] of string;
begin
 StringGrid1.RowCount:= 1;
 StringGrid1.Cells[0, 0]:= 'Символ';
 StringGrid1.Cells[1, 0]:= 'Количество';
 k:= AnsiLowerCase(Edit1.Text);
 c:= 1;

 while Length(k) <> 0 do
  begin
   a:= k[1];;
   b:= 1;
   for i := 2 to Length(k) do
    if k[i] = a then inc(b);
    k:= StringReplace(k, a, '', [rfReplaceAll]);
    StringGrid1.Cells[0, c]:= '"' + a + '"';
    StringGrid1.Cells[1, c]:= IntToStr(b);
    inc(c);
    StringGrid1.RowCount:= c;
  end;
  for r := 1 to StringGrid1.RowCount - 1 do
   begin
   m:= r;
   for i := r to StringGrid1.RowCount - 1 do
    if StrToInt(StringGrid1.Cells[1,i]) > StrToInt(StringGrid1.Cells[1,m]) then
      m := i;
   if r <> m then
    begin
     for c := 0 to 1 do
      begin
       buf[c]:= StringGrid1.Cells[c, r];
       StringGrid1.Cells[c, r]:= StringGrid1.Cells[c, m];
       StringGrid1.Cells[c, m]:= buf[c];
     end;
   end;
 end;
end;
Ответить с цитированием