delphi - 位图裁剪 : some misunderstandings and some help would be welcome

Question

我正在开发一个集成位图裁剪的小项目，但预期的结果并不在这里。
示例 firemonkey 项目有一个加载了图片的 TImage。我正在绘制一个矩形来选择应该“提取”哪种位图部分。这是得到的结果:

所以，当我点击“裁剪”按钮时，结果是:

如您所见，在顶部和底部，我丢失了一些位图线。
这是 OnClick 事件背后的代码:

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;

如果有人可以帮助我解决我的代码有什么问题，那就太好了。
@Tom Brunberg 这里是您可以下载示例项目的链接
CropPicture.rar
谢谢

Answer 1

需要进行比例计算，但我不确定为什么要计算水平和垂直的不同比例，所以我通过简单地将更高的比例分配给另一个来消除这种差异:

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

您可能想用单个变量替换它。
这部分纠正了“丢失的像素行”
另一个问题与不同尺寸的原始图片和“剪切部分”有关。为了纠正所选区域(红线矩形)和复制区域的差异，我添加了 offsetX和 OffsetY计算的变量:

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

当图像 WrapMode 时，这是必要的是 Fit保持图像纵横比。
在 PC 上测试更容易，所以我用两个并排的图像修改了测试应用程序，结果如下:

选择指示器是 1 像素红线，矩形填充 30% 浅灰色。右侧图片与左侧图片上的选定区域匹配，即使左侧图片受上下边限制，右侧图片受左侧和右侧限制。
我重命名了这个过程，因为我从不同的地方调用它(比如在调整表单大小和用鼠标拖动选择矩形时，仍然需要一些调整；))

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;