type
  TCell= record
    cx, cy, cz: integer;
    next: integer;
    end;

var
  c: array of TCell;
  ndx: array of array of integer;
  h: array[0..4, 0..4] of integer= (
    (0,1,4,3,0),
     (1,5,1,5,0),
    (2,3,2,4,6),
     (2,6,4,2,0),
    (0,3,1,2,0));

procedure SortCells;
var
  i, j, k: integer;
  t: TCell;
begin;
  k:=Length(c)-1;
  if k<=0 then exit;
  j:=k; i:=j;
  repeat;
    dec(i);
    if c[i].cz>c[j].cz then j:=i;
    until i<=0;
  if j<>k then begin;
    t:=c[j]; c[j]:=c[k]; c[k]:=t;
    end;

  i:=k-1;
  while i>0 do begin;
    j:=i; dec(i);
    if c[i].cz>c[j].cz then begin;
      repeat;
        inc(j);
        until not (c[i].cz>c[j].cz);
      dec(j);
      t:=c[i];
      for k:=i to j-1 do c[k]:=c[k+1];
      c[j]:=t;
      end;
    end;
  end;

procedure ReadCells;
var
  x, y, xcount, ycount, i: integer;
begin;
  ycount:=Length(h);
  xcount:=Length(h[0]);
  SetLength(c, ycount*xcount);
  for y:=0 to ycount-1 do for x:=0 to xcount-1 do with c[y*xcount + x] do begin;
    cx:=x; cy:=y; cz:=h[y,x];
    end;
  SortCells;
  SetLength(ndx, ycount, xcount);
  for i:=0 to Length(c)-1 do ndx[c[i].cy, c[i].cx]:=i;
  end;

function Neighbour(i, j: integer): integer;
var
  x, y, d: integer;
begin;
  Result:=-1;
  x:=c[i].cx;
  y:=c[i].cy;
  d:=0; if y and 1=0 then d:=-1;
  case j of
    0: begin; x:=x+d; y:=y-1; end;
    1: begin; x:=x+d+1; y:=y-1; end;
    2: x:=x-1;
    3: x:=x+1;
    4: begin; x:=x+d; y:=y+1; end;
    5: begin; x:=x+d+1; y:=y+1; end;
    else begin; x:=-1; y:=-1; end;
    end;
  if (y>=0) and (y<Length(ndx)) and (x>=0) and (x<Length(ndx[0])) then Result:=ndx[y,x];
  end;

function CountCells(last: integer): integer;
var
  i, j, n, k, sum: integer;
begin;
  Result:=0;
  for i:=0 to last do begin;
    c[i].next:=i;
    for j:=0 to 5 do begin;
      n:=Neighbour(i,j);
      if n<0 then c[i].next:=-1
      else if n<i then begin;
        repeat;
          k:=n; n:=c[n].next;
          until (k=n) or (n<0);
        if n<0 then c[i].next:=-1 else c[n].next:=i;
        end;
      end;
    end;
  for i:=0 to last do begin;
    sum:=0; n:=i;
    repeat;
      inc(sum);
      k:=n; n:=c[n].next;
      if k>=0 then c[k].next:=-1;
      until (k=n) or (n<0);
    if n>=0 then
    Result:=Result+sum;
    end;
  end;

function FillCells: integer;
var
  i, dz: integer;
begin;
  Result:=0;
  ReadCells;
  for i:=0 to Length(c)-2 do begin;
    dz:=c[i+1].cz - c[i].cz;
    if dz>0 then
    Result:=Result + dz * CountCells(i);
    end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin;
  Memo1.Lines.Add(IntToStr(FillCells));
  end;