Procedure HeapSort(var v:vetor;tam:integer);

Procedure TransformaHeap(var v:vetor;pos:integer;tam:integer);
var
   esq,dir,maior,aux : integer;
begin
   esq := FilhoEsq(pos);
   dir := FilhoDir(pos);

   if (esq <= tam) AND (v[esq] > v[pos]) then
      maior := esq
   else
      maior := pos;
   if (dir <= tam) AND (v[dir] > v[maior]) then
      maior := dir;
   if maior <> pos then
   begin
      aux := v[pos];
      v[pos] := v[maior];
      v[maior] := aux;
      TransformaHeap(v,maior,tam);
   end;
end;

Procedure CriaHeap(var v:vetor;tam:integer);
var
   i : integer;
begin
   for i := tam div 2 downto 1 do
      TransformaHeap(v,i,tam);
end;

var
   i, aux : integer;
begin
   CriaHeap(v,tam);
   for i := tam downto 2 do
   begin
      aux := v[1];
      v[1] := v[tam];
      v[tam] := aux;
      dec(tam);
      TransformaHeap(v,1,tam);
   end;
end;