procedure ResizeTPA(var TPA: TPointArray; AWidth, AHeight: Integer);
var
  w, h, l, i, x, y: Integer;
  m: array of TBoolArray;
  b: TBox;
begin
  l := Length(TPA);
  if (l > 0) then
  begin
    b := GetTPABounds(TPA);
    w := ((b.X2 - b.X1) + 1);
    h := ((b.Y2 - b.Y1) + 1);
    if (AWidth <> w) or (AHeight <> h) then
    begin
      SetLength(m, w);
      for x := 0 to (w - 1) do
      begin
        SetLength(m[x], h);
        for y := 0 to (h - 1) do
          m[x][y] := False;
      end;
      for i := 0 to (l - 1) do
        m[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)] := True;
      SetLength(TPA, 0);
      l := 0;
      for y := 0 to (AHeight - 1) do
        for x := 0 to (AWidth - 1) do
          if m[((x * w) div aWidth)][((y * h) div aHeight)] then
          begin
            SetLength(TPA, (l + 1));
            TPA[l] := Point((x + b.X1), (y + b.Y1));
            Inc(l);
          end;
    end;
  end;
end;