ClearDoubleTPA

procedure ClearDoubleTPA(var TPA: TPointArray);
var
  v, h, r: Integer;
  B: array of TBoolArray;
  bx: TBox;
begin;
  h := High(TPA);
  if (h > 0) then
  begin
    r := 0;
    bx := GetTPABounds(TPA);
    SetLength(B, ((bx.X2 - bx.X1) + 1), ((bx.Y2 - bx.Y1) + 1));
    for v := 0 to h do
      if not B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] then
      begin
        B[(TPA[v].X - bx.X1)][(TPA[v].Y - bx.Y1)] := True;
        TPA[r] := TPA[v];
        Inc(r);
      end;
    SetLength(TPA, r);
  end;
end;