unit Unit10;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ar: array [0..99] of integer;

implementation

{$R *.dfm}

procedure Sort(var Arr: array of integer; Count: Integer);
 
  procedure DownHeap(index, Count: integer; Current: integer);
  //Функция пробегает по пирамиде восстанавливая ее
  //Также используется для изначального создания пирамиды
  //Использование: Передать номер следующего элемента в index
  //Процедура пробежит по всем потомкам и найдет нужное место для следующего элемента
  var
    Child: Integer;
  begin
    while index < Count div 2 do begin
      Child := (index+1)*2-1;
      if (Child < Count-1) and (Arr[Child] < Arr[Child+1]) then
        Child:=Child+1;
      if Current >= Arr[Child] then
        break;
      Arr[index] := Arr[Child];
      index := Child;
    end;
    Arr[index] := Current;
  end;
 
//Основная функция
var
  i: integer;
  Current: integer;
begin
  //Собираем пирамиду
  for i := (Count div 2)-1 downto 0 do
    DownHeap(i, Count, Arr[i]);
  //Пирамида собрана. Теперь сортируем
  for i := Count-1 downto 0 do begin
    Current := Arr[i]; //перемещаем верхушку в начало отсортированного списка
    Arr[i] := Arr[0];
    ar[i]:= arr[i];
    DownHeap(0, i, Current); //находим нужное место в пирамиде для нового элемента
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  Memo1.Clear;
  Memo2.Clear;
  for i:= 0 to 99 do
    begin
      ar[i]:= random(100);
      Memo1.Lines.Add(IntToStr(ar[i]));
    end;
  Sort(ar, 100);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  for I := 0 to 99 do
    Memo2.Lines.Add(IntToStr(ar[i]))
end;

end.