Dilation Fixed

{$loadlib pumbaa.dll}

const
  BMP_WIDTH = 500;  //Disabled
  BMP_HEIGHT = 500; //Disabled
  ITERATIONS = 50;

var
  TPA: TPointArray;

procedure Setup;
begin
  TPA := [Point(150, 250), Point(250, 151), Point(358, 252), Point(400, 200), Point(355, 351)];
end;

{
procedure TPADilation(var TPA: TPointArray; iterations: Integer);
var
  w, h, l, i, j, c, s, g, n, t, q: Integer;
  m: T2DIntegerArray;
  o, d: TIntegerArray;
  se: TStructuringElement;
  p: TPoint;
  b: TBox;
begin
  if (iterations > 0) then
  begin
    l := Length(TPA);
    if (l > 0) then
    begin
      b := pp_TPABounds(TPA);
      pp_BoxResize(b, (iterations + 1));
      pp_BoxDimensions(b, w, h);
      m := pp_Create(0, w, h);
      se := pp_SE_Cross(1, 1, -1, 1, 1);
      g := 3;
      c := 0;
      for i := 0 to (l - 1) do
        if not (m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] = 1) then
        begin
          m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 1;
          TPA[c] := TPA[i];
          c := (c + 1);
        end;
      l := (l - (l - c));
      s := (l - 1);
      if (c > 0) then
        SetLength(TPA, l);
      q := l;
      d := pp_TIAByRange(0, (w * h));
      o := pp_Clone(d);
      t := 0;
      repeat
        n := 0;
        case (t and 1) of
          0:
          for i := 0 to s do
            for j := 0 to g do
            begin
              p.X := (TPA[o[i]].X + se[j].pixel.X);
              p.Y := (TPA[o[i]].Y + se[j].pixel.Y);
              if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
              begin
                if l>=q then
                begin
                  q := q+q;
                  SetLength(TPA, q);
                end;
                TPA[l] := p;
                m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
                d[n] := l;
                n := (n + 1);
                l := (l + 1);
              end;
            end;
          1:
          for i := 0 to s do
            for j := 0 to g do
            begin
              p.X := (TPA[d[i]].X + se[j].pixel.X);
              p.Y := (TPA[d[i]].Y + se[j].pixel.Y);
              if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
              begin
                if l>=q then
                begin
                  q := q+q;
                  SetLength(TPA, q);
                end;
                TPA[l] := p;
                m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
                o[n] := l;
                n := (n + 1);
                l := (l + 1);
              end;
            end;
        end;
        s := (n - 1);
        t := (t + 1);
      until (t >= iterations);
    end;
  end;
  SetLength(TPA, l);
end;
}

procedure TPADilation(var TPA: TPointArray; iterations: Integer);
var
  w, h, l, i, j, c, s, g, n, t: Integer;
  m: T2DIntegerArray;
  o, d: TIntegerArray;
  se: TStructuringElement;
  p: TPoint;
  b: TBox;
begin
  if (iterations > 0) then
  begin
    l := Length(TPA);
    if (l > 0) then
    begin
      b := pp_TPABounds(TPA);
      pp_BoxResize(b, (iterations + 1));
      pp_BoxDimensions(b, w, h);
      m := pp_Create(0, w, h);
      se := pp_SE_Cross(1, 1, -1, 1, 1);
      g := 3;
      c := 0;
      for i := 0 to (l - 1) do
        if not (m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] = 1) then
        begin
          m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 1;
          TPA[c] := TPA[i];
          c := (c + 1);
        end;
      l := (l - (l - c));
      s := (l - 1);
      if (c > 0) then
        SetLength(TPA, l);
      d := pp_TIAByRange(0, (w * h));
      o := pp_Clone(d);
      t := 0;
      repeat
        n := 0;
        case (t and 1) of
          0:
          for i := 0 to s do
            for j := 0 to g do
            begin
              p.X := (TPA[o[i]].X + se[j].pixel.X);
              p.Y := (TPA[o[i]].Y + se[j].pixel.Y);
              if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
              begin
                SetLength(TPA, (l + 1));
                TPA[l] := p;
                m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
                d[n] := l;
                n := (n + 1);
                l := (l + 1);
              end;
            end;
          1:
          for i := 0 to s do
            for j := 0 to g do
            begin
              p.X := (TPA[d[i]].X + se[j].pixel.X);
              p.Y := (TPA[d[i]].Y + se[j].pixel.Y);
              if (m[(p.X - b.X1)][(p.Y - b.Y1)] = 0) then
              begin
                SetLength(TPA, (l + 1));
                TPA[l] := p;
                m[(p.X - b.X1)][(p.Y - b.Y1)] := 1;
                o[n] := l;
                n := (n + 1);
                l := (l + 1);
              end;
            end;
        end;
        s := (n - 1);
        t := (t + 1);
      until (t >= iterations);
    end;
  end;
end;

procedure DebugBitmap(bmp: Integer);
var
  w, h: Integer;
begin
  GetBitmapSize(bmp, w, h);
  DisplayDebugImgWindow(w, h);
  DrawBitmapDebugImg(bmp);
end;

var
  t, b: Integer;

begin
  b := CreateBitmap(500, 500);
  Setup;
  t := GetTimeRunning;
  TPADilation(TPA, ITERATIONS);
  WriteLn(GetTimeRunning - t);
  DrawTPABitmap(b, TPA, 255);
  DebugBitmap(b);
end.