procedure TPAUnique(var TPA: TPointArray);
var
  h, h2, i, i2, i3, d: Integer;
begin
  h := High(TPA);
  if (h < 1) then
    Exit;
  for i := (h - d) downto 1 do
    for i2 := (i - 1) downto 0 do
      if ((TPA[i].X = TPA[i2].X) and (TPA[i].Y = TPA[i2].Y)) then
      begin
        h2 := High(TPA);
        for i3 := i to (h2 - 1) do
          TPA[i3] := TPA[(i3 + 1)];
        SetLength(TPA, h2);
        Inc(d);
        Break;
      end;
end;

function TPAUniqueIDs(TPA: TPointArray): TIntegerArray;
var
  h, r, x, y: Integer;
begin
  h := High(TPA);
  SetLength(Result, (h + 1));
  if (h > -1) then
  case (h = 0) of
    False:
    begin
      for x := 0 to h do
      begin
        for y := 0 to h do
          if (y <> x) then
            if ((TPA[x].X = TPA[y].X) and (TPA[x].Y = TPA[y].Y)) then
              Break;
        if (y > h) then
        begin
          Result[r] := x;
          Inc(r);
        end;
      end;
      SetLength(Result, r);
    end;
    True: Result[0] := 0;
  end;
end;

function TPADensity(TPA: TPointArray): Extended;
var
  h, l, i, r, d, x, y: Integer;
  b: TBox;
begin
  h := High(TPA);
  case (h > -1) of
    True:
    begin
      if (h > 0) then
      for i := (h - d) downto 1 do
        for x := (i - 1) downto 0 do
          if ((TPA[i].X = TPA[x].X) and (TPA[i].Y = TPA[x].Y)) then
          begin
            l := High(TPA);
            for y := i to (l - 1) do
              TPA[y] := TPA[(y + 1)];
            SetLength(TPA, l);
            Inc(d);
            Break;
          end;
      b := GetTPABounds(TPA);
      Result := (Extended(Length(TPA)) / (((b.X2 - b.X1) + 1) * ((b.Y2 - b.Y1) + 1)));
    end;
    False: Result := 0;
  end;
end;

procedure TPAReplace(var TPA: TPointArray; oldPoint, newPoint: TPoint);
var
  h, i: Integer;
begin
  if ((oldPoint.X <> newPoint.X) and (oldPoint.Y <> newPoint.Y)) then
  begin
    h := High(TPA);
    for i := 0 to h do
      if ((TPA[i].X = oldPoint.X) and (TPA[i].Y = oldPoint.Y)) then
        TPA[i] := TPoint(newPoint);
  end;
end;

procedure TPAReplaceEx(var TPA: TPointArray; oldPoints: TPointArray; newPoint: TPoint);
var
  h, i: Integer;
begin
  if (High(oldPoints) > -1) then
  begin
    h := High(TPA);
    for i := 0 to h do
      if PointInTPA(TPA[i], oldPoints) then
        TPA[i] := TPoint(newPoint);
  end;
end;

procedure TPAFill(var TPA: TPointArray; pt: TPoint);
var
  h, i: Integer;
begin
  h := High(TPA);
  for i := 0 to h do
    TPA[i] := TPoint(pt);
end;

procedure TPAFillIDs(var TPA: TPointArray; IDs: TIntegerArray; pt: TPoint);
var
  h, l, i: Integer;
begin
  l := Length(TPA);
  h := High(IDs);
  if ((l > 0) and (h > -1)) then
  for i := 0 to h do
    if ((IDs[i] < l) and (IDs[i] > -1)) then
      TPA[IDs[i]] := TPoint(pt);
end;

var
  TPA: TPointArray;

begin
  TPA := [Point(10, 10), Point(15, 15), Point(12, 12), Point(18, 20), Point(25, 20), Point(12, 12)];
  WriteLn('TPA BEFORE: ' + ToStr(TPA));
  TPAFillIDs(TPA, [1, 2, 3], Point(6, 9));
  WriteLn('TPA AFTER: ' + ToStr(TPA));
  WriteLn(ToStr(TPAUniqueIDs(TPA)));
  WriteLn(FloatToStr(TPADensity(TPA)));
  WriteLn(FloatToStr(0.1 * 0.01));
end.