Erosion and Shrink

procedure TPAErosion(var TPA: TPointArray; iterations: Integer);
var
  w, h, l, i, j, c, s, g, n, t, q: Integer;
  m: T2DIntegerArray;
  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_BoxExpand(b);
      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));
      if (c > 0) then
        SetLength(TPA, l);
      t := 0;
      repeat
        n := 0;
        s := (l - 1);
        for i := 0 to s do
        begin
          q := 0;
          for j := 0 to g do
          begin
            p.X := (TPA[i].X + se[j].pixel.X);
            p.Y := (TPA[i].Y + se[j].pixel.Y);
            q := (q + m[(p.X - b.X1)][(p.Y - b.Y1)]);
          end;
          if ((q > 0) and (q < 4)) then
          begin
            m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 0;
            l := (l - 1);
          end else
          begin
            TPA[n] := TPA[i];
            n := (n + 1);
          end;
        end;
        t := (t + 1);
      until ((t >= iterations) or (l <= 1));
    end;
    SetLength(TPA, l);
  end;
end;

procedure TPAShrink(var TPA: TPointArray; iterations: Integer);
var
  w, h, l, i, j, c, s, g, n, t, q: Integer;
  m: T2DIntegerArray;
  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_BoxExpand(b);
      pp_BoxDimensions(b, w, h);
      m := pp_Create(0, w, h);
      se := pp_SE_Rectangle(1, 1, 1, 1, -1, 1, 1, 1, 1);
      g := 7;
      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));
      if (c > 0) then
        SetLength(TPA, l);
      t := 0;
      repeat
        n := 0;
        s := (l - 1);
        for i := 0 to s do
        begin
          q := 0;
          for j := 0 to g do
          begin
            p.X := (TPA[i].X + se[j].pixel.X);
            p.Y := (TPA[i].Y + se[j].pixel.Y);
            q := (q + m[(p.X - b.X1)][(p.Y - b.Y1)]);
          end;
          if ((q > 0) and (q < 8)) then
          begin
            m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := 0;
            l := (l - 1);
          end else
          begin
            TPA[n] := TPA[i];
            n := (n + 1);
          end;
        end;
        t := (t + 1);
      until ((t >= iterations) or (l <= 1));
    end;
    SetLength(TPA, l);
  end;
end;