5

取下面的图像，我将用于以下示例：

未更改的尺寸目前是96 x 71

在此处输入图像描述

假设我想将画布调整为115 x 80- 生成的图像应该是：

在此处输入图像描述

最后，如果我将其调整为比原始画布更小的尺寸，例如45 x 45输出将如下所示：

在此处输入图像描述

这是我到目前为止所尝试的：

procedure ResizeBitmapCanvas(Bitmap: TBitmap; H, W: Integer);
var
  Bmp: TBitmap;
  Source, Dest: TRect;
begin
  Bmp := TBitmap.Create;
  try
    Source := Rect(0, 0, Bitmap.Width, Bitmap.Height);
    Dest := Source;
    Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2);
    Bitmap.SetSize(W, H);
    Bmp.Assign(Bitmap);
    Bmp.Canvas.FillRect(Source);
    Bmp.Canvas.CopyRect(Dest, Bitmap.Canvas, Source);
    Bitmap.Assign(Bmp);
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ResizeBitmapCanvas(Image1.Picture.Bitmap, 110, 110);
end;

如果您在加载到 TImage 的位图上尝试上述操作，则实际位图不会居中，但是画布确实会改变大小。

我为图像设置的属性是：

Image1.AutoSize := True;
Image1.Center   := True;
Image1.Stretch  := False;

我认为这可能是Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2);需要查看的线来计算正确的中心位置？

该代码已根据 David Heffernan 最近回答的问题进行了略微修改/修改。

如何调整围绕位图的画布大小，但不拉伸位图？

4

1 回答 1

6

我认为这就是你要找的：

procedure ResizeBitmapCanvas(Bitmap: TBitmap; H, W: Integer; BackColor: TColor);
var
  Bmp: TBitmap;
  Source, Dest: TRect;
  Xshift, Yshift: Integer;
begin
  Xshift := (Bitmap.Width-W) div 2;
  Yshift := (Bitmap.Height-H) div 2;

  Source.Left := Max(0, Xshift);
  Source.Top := Max(0, Yshift);
  Source.Width := Min(W, Bitmap.Width);
  Source.Height := Min(H, Bitmap.Height);

  Dest.Left := Max(0, -Xshift);
  Dest.Top := Max(0, -Yshift);
  Dest.Width := Source.Width;
  Dest.Height := Source.Height;

  Bmp := TBitmap.Create;
  try
    Bmp.SetSize(W, H);
    Bmp.Canvas.Brush.Style := bsSolid;
    Bmp.Canvas.Brush.Color := BackColor;
    Bmp.Canvas.FillRect(Rect(0, 0, W, H));
    Bmp.Canvas.CopyRect(Dest, Bitmap.Canvas, Source);
    Bitmap.Assign(Bmp);
  finally
    Bmp.Free;
  end;
end;

我不记得 XE 是否支持设置Width和Height用于TRect. 如果没有，则将代码更改为

Source.Right := Source.Left + Min(W, Bitmap.Width);

等等。

于 2012-05-08T17:32:18.550 回答