使用Delphi对图像进行裁剪、缩放和居中处理

Question

有人知道在Delphi中裁剪、缩放和居中图像（jpg或位图）的方法吗？ 我有一张高分辨率的图片，想将其缩放到低分辨率。目标分辨率的比率可能与原始图片不同。我想保持原始照片的纵横比，因此不想拉伸到新的分辨率，而是裁剪并居中，以最好地适应并尽量少地丢失原始图片的数据。有人知道如何使用Delphi实现吗？

- bashan

---

下定决定吧。裁剪还是调整大小？ - David Heffernan

请提供一个函数接口的框架。你的输入和输出是什么？我猜你想要调整大小以填充目标图像的边缘，并裁剪超出边界的部分。 - Marcus Adams

@David OP想要进行缩放和裁剪。在我看来没有任何混乱之处。 - NGLN

@NGLN 好的，我现在明白了。我的错。 - David Heffernan

Answer 1

我猜您希望将图像的大小调整为填充目标图像边缘，并裁剪超出边界的部分。

以下是伪代码。具体实现取决于您正在使用什么。

// Calculate aspect ratios
sourceAspectRatio := souceImage.Width / sourceImage.Height;
targetAspectRatio := targetImage.Width / targetImage.Height;

if (sourceAspectRatio > targetAspectRatio) then
begin
  // Target image is narrower, so crop left and right
  // Resize source image
  sourceImage.Height := targetImage.Height;
  // Crop source image
  ..
end
else
begin
  // Target image is wider, so crop top and bottom
  // Resize source image
  sourceImage.Width := targetImage.Width;
  // Crop source image
  ..
end;

- Marcus Adams

---

实现还取决于提问者真正想要做什么，因为问题的措辞实际上是自相矛盾的。 - Ken White

@Ken 我认为这并不冲突。OP想要保持源图像的纵横比，并将其拉伸到目标矩形的外边界。如果该目标没有相同的纵横比，则源图像必须进行裁剪。 - NGLN

感谢您的回答。我想将一张照片加载到屏幕上的预定义位置。这个预定义位置有固定的宽度和高度。所以我可能需要做两件事情：将图像重新调整大小到合适的尺寸，然后在中心裁剪它以完全适应该位置。我不想对图像进行任何拉伸，以保持其纵横比。 - bashan

如果我没记错的话，@Marcus 给了你答案，请考虑接受它是否有帮助。 - user497849

谢谢，这给了我一个良好的方向。我原以为网上有一些现成的函数，可以将图像输入并输出到新图像中，考虑所需的尺寸。但这已经足够好了。 - bashan

Answer 2

这里只回答您的数学问题。请另外提出一个关于保持最大图像质量的问题。

您需要确定绘制图像的比例和位置。我建议您尝试以下程序：

function CropRect(const Dest: TRect; SrcWidth, SrcHeight: Integer): TRect;
var
  W: Integer;
  H: Integer;
  Scale: Single;
  Offset: TPoint;
begin
  W := Dest.Right - Dest.Left;
  H := Dest.Bottom - Dest.Top;
  Scale := Max(W / SrcWidth, H / SrcHeight);
  Offset.X := (W - Round(SrcWidth * Scale)) div 2;
  Offset.Y := (H - Round(SrcHeight * Scale)) div 2;
  with Dest do
    Result := Rect(Left + Offset.X, Top + Offset.Y, Right - Offset.X,
      Bottom - Offset.Y);
end;

以下是一个示例调用代码：

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FGraphic: TGraphic;
  end;

implementation

{$R *.dfm}

uses
  Jpeg, Math, MyUtils;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FGraphic := TJPEGImage.Create;
  FGraphic.LoadFromFile('MonaLisa.jpg');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FGraphic.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
begin
  R := CropRect(ClientRect, FGraphic.Width, FGraphic.Height);
  Canvas.StretchDraw(R, FGraphic);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

- NGLN

---

如果您确实误解了您的问题，并且您不想裁剪，只需在函数中将Max()改为Min()。 - NGLN