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;