//大根堆
procedure push(x:longint);//元素x入堆 O(log t)
var
  tx,i:longint;
begin
  inc(t);//堆顶top加1
  a[t]:=x;//将x放入堆的最后一个节点
  i:=t;
  while (i>1)and(a[i>>1]<a[i]) do//将元素x一层一层向上传递直到 到达根或上一层大于本身<=>找到x应在的位置
    begin
    tx:=a[i>>1]; 
    a[i>>1]:=a[i]; 
    a[i]:=tx;//将x与父亲交换位置 
    i:=i>>1;//x坐标变成父亲的坐标
    end;
end;
procedure pop;//弹出根并维护堆 O(log t)
var
  tx,i,so:longint;
begin
  a[1]:=a[t];//用最后一个元素覆盖掉第一个再将其向下传
  dec(t);//最后一个元素已经移至根 top减1
  i:=1;
  while (i<<1<=t)or(i<<1+1<=t) do//往下传递
    begin
    if (i<<1>=t)or(a[i<<1]>a[i<<1+1]) then so:=i<<1 else so:=i<<1+1;//右儿子不存在或左儿子大于右儿子则向左传递否则向右
    if a[so]>a[i] then
      begin
      tx:=a[so];
      a[so]:=a[i];
      a[i]:=tx;
      i:=so;
      end
                     else break;
    end; 
end;
原文:http://www.cnblogs.com/2014summer8/p/5879542.html