delphi - 如何打印大于一页的图像

Question

我需要打印从扫描仪获取的图像。
当扫描适合一张 A4 纸时，没有问题，我的代码打印完美。

但是，当扫描不适合，但需要2页时，只打印一页。第一个。

到目前为止，这是我的代码

procedure TFormMain.PrintPicture;
var
  MyRect: TRect;
  Scale: Double;
begin
  try
    Printer.BeginDoc;

    Scale := Printer.PageWidth / ImgHolder.Picture.Bitmap.Width;
    MyRect.Left := 0;
    MyRect.Top := 0;
    MyRect.Right := trunc(ImgHolder.Picture.Bitmap.Width * Scale);
    MyRect.Bottom := trunc(ImgHolder.Picture.Bitmap.Height * Scale);
    Printer.Canvas.StretchDraw(MyRect, ImgHolder.Picture.Bitmap);

    Printer.EndDoc;
  except
    on E:Exception do
    begin
      MessageBox(Handle, PChar('Printing failed' + chr(13) + E.Message), PChar(Caption), MB_OK or MB_ICONWARNING);
    end;
  end;
end;

当图片占一页时，MyRect的高度= 13092
图片有2页时，高度为26185

这对我来说似乎是正确的，但仍然只打印了第一页。所以我一定是做错了，有人能给我指出正确的方向，告诉我如何打印高于一页高度的图像吗

编辑
如果图像较大，我想打印在多个页面上。
我不想将图像缩小到一页。
我的代码中出现比例尺的原因是因为我一开始无法正确打印，我在另一个问题中找到了这段代码，为我解决了这个问题。
但现在看来这种做法是错误的。
因此，如果我能在正确设置打印方面获得一些帮助，我将不胜感激。

如果用户扫描 2 或 3 次，图像将变大，新扫描将添加到图像底部。
这就是图像变得超过一页的原因。 现在我需要完整地打印这张图片，所以如果需要的话可以打印在多页上

Answer 1

打印图像的方法有很多种。

首先，请记住您的屏幕和打印机有不同的分辨率(例如每英寸像素)。通常，打印机的分辨率比 PC 显示器高得多，因此如果您在 A4 页面上打印全屏 1920×1080 图像，除非您放大它，否则页面上的图像会非常小。

现在，话虽如此，让我们考虑两种常见情况(您想要第二种情况)。

缩放图像使其完全适合单个页面

“完美契合”是指图像按比例缩放，保持其纵横比，使其在页面上尽可能大而不会被裁剪。

让(使用数学)

ScaleX := Printer.PageWidth / Bitmap.Width;
ScaleY := Printer.PageHeight / Bitmap.Height;
Scale := Min(ScaleX, ScaleY).

那么 Scale 就是你的比例因子。

的确，ScaleX 是允许图像水平适合页面的最大缩放因子。例如，如果纸张为 1000×1000，图像为 2000×1000，显然需要将其缩小到至少 ScaleX = 50% 以使其适合水平方向。另一方面，如果图像是 1000×5000，问题不是宽度而是高度，显然需要将其缩小到至少 ScaleY = 20% 以使其适合垂直方向。

因此，如果图像是 2000×5000，则需要比例因子为 50% 或更小才能使其水平适合，而比例因子必须为 20% 或更小才能使其垂直适合。满足这两个限制的比例因子最大为20%，最小为50%和20%。

procedure PrintBitmap(ABitmap: TBitmap);
begin
  Printer.BeginDoc;
  var ScaleX := Printer.PageWidth / ABitmap.Width;
  var ScaleY := Printer.PageHeight / ABitmap.Height;
  var Scale := Min(ScaleX, ScaleY);
  var W := Round(ABitmap.Width  * Scale);   // Note: scaling proportionally,
  var H := Round(ABitmap.Height * Scale);   //       same factor
  Printer.Canvas.Brush.Color := clRed;
  Printer.Canvas.StretchDraw(
    TRect.Create(                           // Centre on page
      Point((Printer.PageWidth - W) div 2, (Printer.PageHeight - H) div 2),
      W, H
    ),
    ABitmap
  );
  Printer.EndDoc;
end;

例如，

procedure TForm1.FormCreate(Sender: TObject);
begin

  var bm := TBitmap.Create;
  try
    bm.LoadFromFile('K:\Sally.bmp');
    PrintBitmap(bm);
  finally
    bm.Free;
  end;

end;

具有固定的图像大小，可能跨越多个页面

现在，假设您有一个固定的图像大小 (W, H) 并且您希望根据需要在尽可能多的页面上打印它。然后需要循环遍历二维纸格，分别绘制每一页:

procedure PrintBitmap(ABitmap: TBitmap);

var
  W, H: Integer;
  ImgPageWidth, ImgPageHeight: Integer;

  function GetSourceRect(Row, Col: Integer): TRect;
  begin
    Result := TRect.Create(
      Point(Col * ImgPageWidth, Row * ImgPageHeight),
      ImgPageWidth, ImgPageHeight
    );
  end;

  function GetDestRect(Row, Col: Integer): TRect;
  begin
    Result := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
  end;

begin
  Printer.BeginDoc;
  W := ABitmap.Width * 4;    // Hardcoding these in this example
  H := ABitmap.Height * 4;
  ImgPageWidth := Round(ABitmap.Width * (Printer.PageWidth / W));
  ImgPageHeight := Round(ABitmap.Height * (Printer.PageHeight / H));
  var PageCountX := Ceil(W / Printer.PageWidth);   // Image width in pages
  var PageCountY := Ceil(H / Printer.PageHeight);  // Image height in pages
  // Notice that the total page count is PageCountX * PageCountY.
  for var y := 0 to PageCountY - 1 do
    for var x := 0 to PageCountX - 1 do
    begin
      if x + y > 0 then
        Printer.NewPage;
      Printer.Canvas.CopyRect(
        GetDestRect(y, x),
        ABitmap.Canvas,
        GetSourceRect(y, x)
      );
    end;
  Printer.EndDoc;
end;

或