Crop scale and center image with delphi

Question

Does anyone know a way of cropping, scaling and centering an image (jpg or bitmap) using Delphi? I have an image with large resolution. I would like to be able to scale it to a lower resolution. The ratio of the target resolution may be different from the original image. I want to keep the original photo aspect ratio, therefore, I don't want to stretch to the new resolution, but crop and center it, to fit best and loose minimal data from the original image. Does anyone know how can it be done using Delphi?

Answer 1

I'm guessing that you want to resize to fill the target image edge to edge, and crop the part that goes out of bounds.

Here's pseudocode. The implementation will differ depending on what you're working with.

// 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;

Answer 2

Only answering the math part of your question here. Please ask a separate question about keeping maximum image quality.

You need to determine the scale in which to draw the image, as well as the position. I suggest you try this routine:

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;

And a sample calling code:

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;