位图裁剪：一些误解和一些帮助将受到欢迎

Question

我正在做一个集成位图裁剪的小项目，但这里没有预期的结果。示例 firemonkey 项目有一个加载了图片的 TImage。我正在向 select 绘制一个矩形，应该“提取”什么样的位图部分。这是获得的结果：

所以，当我点击“裁剪”按钮时，结果是这样的：

如您所见，在顶部和底部，我丢失了一些位图线。

这是 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 这里是 link 您可以下载示例项目的地方

CropPicture.rar

谢谢

Answer 1

根据 TImage.Bitmap 属性的文档，返回的位图可能已经缩放。

The Bitmap getter uses the following algorithm to retrieve the Bitmap property's value:

Using the GetSceneScale function for the Scene in which the control is drawn, the Bitmap getter retrieves the Scale for the current device. If Scene is not defined, then the 1.0 value for Scale is accepted.

If MultiResBitmap is assigned, then the getter gets the Bitmap from the bitmap item having the scale best matching to the obtained Scale (not including empty bitmap items.)

If the getter does not find any not empty bitmap item, then the getter tries to retrieve an empty bitmap item having the scale exactly matching to the obtained Scale.

If the getter cannot find an empty bitmap item having the obtained Scale, then the getter creates a new bitmap item with the obtained Scale and returns the bitmap from the created bitmap item.

If the obtained Scale <= 0 or MultiResBitmap is not assigned, the exception is raised.

Answer 2

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

  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;

位图裁剪：一些误解和一些帮助将受到欢迎

Bitmap cropping: some misunderstandings and some help would be welcome

delphi

bitmap

firemonkey