Bitmap cropping: some misunderstandings and some help would be welcome

Question

I'm working on a small project integrating bitmap croping but the result expected is not here. The sample firemonkey project has a TImage with a picture loaded. I'm drawing a rectange to select what kind of the bitmap part should be "extracted". Here is the obtained result :

So, when I click on the "Crop" button here is what the result is :

As you could see, on the top and bottom, I've lost some bitpmap lines.

Here is the code behind the OnClick event :

procedure TForm1.Button1Click(Sender: TObject);
var
  lBmp: TBitmap;
  xScale, yScale: extended;
  iRect: TRect;
begin
  if Rectangle1.Visible then
  begin
    lBmp := TBitmap.Create;
    try
      xScale := Image1.Bitmap.Width / Image1.Width;
      yScale := Image1.Bitmap.Height / Image1.Height;

      lBmp.Width := round(Rectangle1.Width * xScale);
      lBmp.Height := round(Rectangle1.Height * yScale);

      iRect.Left := round(Rectangle1.Position.X * xScale);
      iRect.Top := round(Rectangle1.Position.Y * yScale);
      iRect.Width := round(Rectangle1.Width * xScale);
      iRect.Height := round(Rectangle1.Height * yScale);

      lBmp.CopyFromBitmap(Image1.Bitmap, iRect, 0, 0);

      Image1.Bitmap.Clear(0);
      Image1.Bitmap := lBmp;

      Rectangle1.Visible := False;
    finally
      FreeAndNil(lBmp);
    end;
  end
  else
  begin
    Rectangle1.Visible := True;
    Rectangle1.Width := Round(Panel1.Width * 0.5);
    Rectangle1.Height := Round(Rectangle1.Width * 1.41);
    Rectangle1.Position.X := Round(Panel1.Width * 0.5)-(Rectangle1.Width * 0.5);
    Rectangle1.Position.Y := Round(Panel1.Height * 0.5)-(Rectangle1.Height * 0.5);
  end;
end;

If someone could help me on what's wrong with my code, it could be very nice.

@Tom Brunberg here is the link where you could download the sample project

CropPicture.rar

Thank you

Tom Brunberg · Accepted Answer

The scale calculation is needed, but I'm not sure why you calculate different scales for horizontal and vertical, so I removed that difference by simply assigning the higher scale to the other:

  if xScale > yScale
  then yscale := xScale
  else xscale := yScale;

You may want to replace that with a single variable.

This corrects the "missing pixel rows" partly

The other problem is related to different sizes of original picture and the "cut out part". To correct the difference in selected area (red line rectangle) and replicated area, I added offsetX and OffsetY variables that are calculated:

var
  OffsetX, OffsetY: extended;
---

  // added offset terms to compensate for the space between
  // picture and Image1 border
  offsetx := (Image1.Width - Image1.Bitmap.Width / xscale) / 2;
  offsety := (Image1.Height - Image1.Bitmap.Height / yscale) / 2;

  // offset terms added here
  iRect.Left   := round((Rectangle1.Position.X - offsetx) * xscale);
  iRect.Top    := round((Rectangle1.Position.Y - offsety) * yscale);
  iRect.Width  := round(Rectangle1.Width * xscale);
  iRect.Height := round(Rectangle1.Height * yscale);

This is necessary when the images WrapMode is Fit which maintains the images aspect ratio.

It is more easy to test this on a PC, so I modified the test application with two images beside each other and the result is here:

The selection indicator is 1 pixel red line and the rectangle has a fill of 30% light gray. The right side picture matches the selected area on the left picture even though the left picture is limited by top and bottom sides, and the right is limited by the left and right sides.

I renamed the procedure because I call it from different places (like when resizing the form and when dragging the selection rectangle with the mouse, needs some tuning still ;) )

procedure TForm2.UpdateDisplay;
var
  lBmp: TBitmap;
  xScale, yScale, scale: extended;
  iRect: TRect;
  OffsetX, OffsetY: extended;
  BmpHwRatio: extended;
  DispRatio: extended;
begin
  if Rectangle1.Visible then
  begin
    lBmp := TBitmap.Create;
    try
      xScale := Image1.Bitmap.Width / Image1.Width;
      yScale := Image1.Bitmap.Height / Image1.Height;

      if xScale > yScale
      then yscale := xScale
      else xscale := yScale;

      lBmp.Width := round(Rectangle1.Width * xScale);
      lBmp.Height := round(Rectangle1.Height * yScale);

      // added offset terms to compensate for the space between
      // picture and Image1 border
      offsetx := (Image1.Width - Image1.Bitmap.Width / xscale) / 2;
      offsety := (Image1.Height - Image1.Bitmap.Height / yscale) / 2;
// You can test without the offset calculations
//      offsetx := 0;
//      offsety := 0;

      // offset terms added here
      iRect.Left   := round((Rectangle1.Position.X - offsetx) * xscale);
      iRect.Top    := round((Rectangle1.Position.Y - offsety) * yscale);
      iRect.Width  := round(Rectangle1.Width * xscale);
      iRect.Height := round(Rectangle1.Height * yscale);

      if iRect.Left < 0 then iRect.Left := 0;
      if iRect.Top  < 0 then iRect.Top  := 0;
      if iRect.Width < 1 then iRect.Width := 1;
      if iRect.Height > (LBMp.Height-1) then iRect.Height := LBmp.Height;

      lBmp.CopyFromBitmap(Image1.Bitmap, iRect, 0, 0);

      Image2.Bitmap.Clear(0);
      Image2.Bitmap := lBmp;

//      Rectangle1.Visible := False;  outcommented to be able to compare images
    finally
      FreeAndNil(lBmp);
    end;
  end
  else
  begin
    Rectangle1.Visible := True;
    Rectangle1.Width := Round(Panel1.Width * 0.5);
    Rectangle1.Height := Round(Rectangle1.Width * 1.41);
    Rectangle1.Position.X := Round(Panel1.Width * 0.5)-(Rectangle1.Width * 0.5);
    Rectangle1.Position.Y := Round(Panel1.Height * 0.5)-(Rectangle1.Height * 0.5);
  end;
end;

Bitmap cropping: some misunderstandings and some help would be welcome

Answers (2)

Related Questions