переставить и распеччатать слова заданного пердложения в соответствии с ростом доли согласных в этих словах! (Где то ошибка?)

[Vadim_rush]

procedure TForm1.btn1Click(Sender: TObject);
var
 sog,st:string;
 m,n,i,r,j,t,k,u:integer;
 a:array [1..128] of string;
 y:array [1..100] of real;
 x,z:real;
begin
 st:=edt1.Text;
 st:=st+' ';
 n:=0;
 sog:='бвгджзклмнпрстфхцчшщьъ';
 x:=0;
 t:=0;
 while pos(' ',st)<>0 do
  begin
  n:=n+1;
  i:=pos(' ',st);
  r:=i-1;
  a[n]:=copy(st,1,r);
  delete(st,1,i);
  for i:=1 to r do
   for j:=1 to 22 do
    if a[n][i]=sog[j] then
     x:=x+1;
  y[n]:=x/r;
  x:=0;
  end;
  for i:=n downto 2 do
  begin
  m:=1;
  for u:=2 to i do
   if y[n]>m then
   begin
   m:=u ;
   x:=y[i];
   y[i]:=y[m];
   y[m]:=x;
   end;
   end;
  for i:=1 to n do
  Edt2.Text:=edt2.Text+''+(a[i]);

end;

end.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Vadim_rush]

Помогите пожалуйста срочно нужно очень ребята!!!!!!!!!!!

[Serge_Bliznykov]

не смог исправить вашу сортировку (она вообще ни в хвост, ни в гриву не годится

вставил другую.
вроде бы работает. разбирайтесь.

var
  sog, st: string;
  m, n, i, r, j, t, k, u: integer;
  a: array[1..128] of string;
  y: array[1..100] of real;
  x, z: real;
begin
  st := edt1.Text;
  st := st + ' ';
  n := 0;
  sog := 'бвгджзклмнпрстфхцчшщьъ';
  x := 0;
  t := 0;
  while pos(' ', st) <> 0 do
  begin
    n := n + 1;
    i := pos(' ', st);
    r := i - 1;
    a[n] := copy(st, 1, r);
    delete(st, 1, i);
    for i := 1 to r do
      for j := 1 to 22 do
        if a[n][i] = sog[j] then
          x := x + 1;
    y[n] := x / r;
    x := 0;
  end;

  {сортировка массивов A и Y (по величинам массива Y) методом простых обменов  }
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if y[i] > y[j]then
        begin
          x := y[i];
          y[i] := y[j];
          y[j] := x;
          {и переставим таким же образом слова в массива A}
          st := a[i];
          a[i] := a[j];
          a[j] := st
        end;

  Edt2.Text := '';
  for i := 1 to n do
    Edt2.Text := edt2.Text + ' ' + (a[i]);

p.s.
1-е. вместо цикла перебора по согласным достаточно проверять наличие фунцией POS - вот так, например:

    for i := 1 to r do
       if Pos(a[n][i], sog)>0 then x := x + 1;
    y[n] := x / r;

2-е. учтите, у вас код ищет только строчные буквы, ПРОПИСНЫЕ ИГНОРИРУЮТСЯ!
разумеется, это легко решается приведением к одному регистру, например, к нижнему, раз уж согласные перечислены в строчном виде

    for i := 1 to r do
       if Pos(AnsiLowerCase(a[n][i]), sog)>0 then x := x + 1;