GuidoG
GuidoG

Reputation: 12014

How to print image that is larger than one page

I need to print an image that is aquired from a scanner.
When the scan fits on one A4 page, there is no problem and my code prints perfect.

However, when the scan does not fits, but needs 2 pages, only one page is printed. The first.

This is my code so far

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;

when the image holds one page, the height of MyRect = 13092
when the image holds 2 pages, the height is 26185

This seems correct to me, but still only the first page is printed. So I must be doing it all wrong, can someone please point me in the correct direction on how to print an image that is higher then the height of one page

EDIT
I want to print on more than one page if the image is larger.
I do not want to scale down the image to one page.
The reason for the scale in my code is because I could not print correct at first, and I find this code in another question that solved that for me.
But now it seems this approach is wrong.
So I would appreciate if I could get some help in setting up my printing correct.

If the user scans 2 or 3 times, the image will be made larger and the new scan will be added to the image at the bottom.
This is how the image gets longer than one page.
Now I need to print this image complete, so on more than one page if needed

Upvotes: 2

Views: 598

Answers (2)

Andreas Rejbrand
Andreas Rejbrand

Reputation: 108929

There are many ways to print an image.

First, please remember that your screen and your printer have different resolutions (in pixels per inch, say). Typically, a printer has much higher resolution than a PC monitor, so if you print your full-screen 1920×1080 image on an A4 page, you will get a very small image on the page unless you magnify it.

Now, having said that, let's us consider two common scenarios (you want the second one).

Scaling the image so it fits perfectly on a single page

By "fits perfectly", I mean the image is scaled proportionally, preserving its aspect ratio, so that it is as large as possible on the page without being clipped.

Let (uses Math)

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

Then Scale is your scaling factor.

Indeed, ScaleX is the greatest scaling factor that allows the image to fit the page horizontally. For instance, if the paper is 1000×1000 and the image 2000×1000, you clearly need to shrink it to at least ScaleX = 50% to make it fit horizontally. On the other hand, if the image is 1000×5000, the problem is not the width but the height, and you clearly need to shrink it to at least ScaleY = 20% to make it fit vertically.

So if the image is 2000×5000, you need the scale factor to be 50% or less to make it fit horizontally, and you need the scale factor to be 20% or less to make it fit vertically. The greatest scale factor satisfying these two restrictions is 20%, the minimum of 50% and 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;

For example,

procedure TForm1.FormCreate(Sender: TObject);
begin

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

end;

Screenshot of printed page

Having a fixed image size, potentially spanning several pages

Now, instead suppose you have a fixed image size (W, H) and you want to print it on as many pages as needed. Then you need to loop through the 2D paper grid and draw each page separately:

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;

Screenshot of all eight pages

or

Screenshot of all nine pages, if printed in landscape

Upvotes: 8

fpiette
fpiette

Reputation: 12292

To print a big image on several pages, you have to loop on the width and on the height (two loops) to create pages with partial image. To print one partial image, you can use TCanvas.CopyRect

Upvotes: 2

Related Questions