procedure ResizeTPA(var TPA: TPointArray; width, height: 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 (width <> w) or (height <> 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 (height - 1) do
        for x := 0 to (width - 1) do
          if m[((x * w) div width)][((y * h) div height)] then
          begin
            SetLength(TPA, (l + 1));
            TPA[l] := Point((x + b.X1), (y + b.Y1));
            Inc(l);
          end;
    end;
  end;
end;

procedure SetPixels(bmp: Integer; TPA: TPointArray; color: Integer);
var
  a, b, w, h: Integer;
begin
  b := High(TPA);
  if (b > -1) then
  begin
    try
      GetBitmapSize(bmp, w, h);
    except
      Exit;
    end;
    for a := 0 to b do
      if ((TPA[a].X > -1) and (TPA[a].Y > -1) and (TPA[a].X < w) and (TPA[a].Y < h)) then
        FastSetPixel(bmp, TPA[a].X, TPA[a].Y, color);
  end;
end;

var
  TPA: TPointArray;
  bmp: Integer;
  b: TBox;

const
  ZOOM = 10;

begin
  bmp := CreateBitmap(500, 500);
  TPA := [Point(11, 12), Point(13, 14), Point(15, 16), Point(17, 18)];
  b := GetTPABounds(TPA);
  WriteLn((b.X2 - b.X1) + 1);
  WriteLn((b.Y2 - b.Y1) + 1);
  WriteLn(ToStr(b));
  ResizeTPA(TPA, ((b.X2 - b.X1) + 1) * ZOOM, ((b.Y2 - b.Y1) + 1) * ZOOM);
  b := GetTPABounds(TPA);
  ResizeTPA(TPA, ((b.X2 - b.X1) + 1) div 2 , ((b.Y2 - b.Y1) + 1) div 2);
  b := GetTPABounds(TPA);
  WriteLn((b.X2 - b.X1) + 1);
  WriteLn((b.Y2 - b.Y1) + 1);
  WriteLn(ToStr(b));
  SetPixels(bmp, TPA, 255);
  DisplayDebugImgWindow(500, 500);
  DrawBitmapDebugImg(bmp);
  WriteLn(ToStr(TPA));
end.