Peter Martin's Delphi Tips

Printing a Bitmap

function InchToPixelsX (I : single) : integer;
  // convert I inches into printer pixels
begin
  Result:= round(I * GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX));
end;

procedure DrawImage(Canvas : TCanvas; DestRect : TRect; ABitmap : TBitmap);
  // paint image on printer's canvas; method avoids many problems with
  // using StretchDraw etc functions
var
  Header, Bits : pointer;
  HeaderSize   : integer;
  BitsSize     : longint;
begin
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  GetMem(Header, HeaderSize);
  // Header:= MemAlloc(HeaderSize);
  GetMem(Bits, BitsSize);
  // Bits:= MemAlloc(BitsSize);
  try
    GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
    StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
    DestRect.Right, DestRect.Bottom, 0, 0, ABitmap.Width, ABitmap.Height,
      Bits,TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY);
    // might want to try DIB_PAL_COLORS instead
  finally
    FreeMem(Header);
    FreeMem(Bits);
    // MemFree(Header, HeaderSize);
    // MemFree(Bits, BitsSize);
    end;
end;

procedure PrintBitmap (Title : string; ABitmap: TBitmap);
  // print a bitmap image in ABitmap, using the whole Printer page; 

  // if title provided, print it 0.5" from top, and start image 0.25" lower
var
  TitleX, 

  TitleY,
  AvailH,
  RelHeight, 

  RelWidth    : integer;
begin
  Printer.BeginDoc;
  if length(Title) = 0 then
    TitleX:= 0
  else
    TitleX:= InchToPixelsX(0.5);
  TitleY:= TitleX;
  AvailH:= Printer.PageHeight - TitleY;
  if (ABitmap.Width / ABitmap.Height) > (Printer.PageWidth / AvailH) then begin
    // stretch bitmap to width of printer page
    RelWidth:= Printer.PageWidth;
    RelHeight:= MulDiv(ABitmap.Height, Printer.PageWidth, ABitmap.Width); 
    end
 else begin
   // stretch bitmap to height of printer page
   RelWidth:= MulDiv(ABitmap.Width, AvailH, ABitmap.Height);
   RelHeight:= AvailH;
   end;
 DrawImage(Printer.Canvas, Rect(0, TitleY, RelWidth, RelHeight), ABitmap);
 if length(Title) > 0 then
   // print Title string at top of page
   with Printer.Canvas do begin
     Font.Name:= 'Courier New';
     Font.Size:= 12;
     Font.Color:= clBlack;
     TextOut(TitleX, TitleY, Title);
     end;
  Printer.EndDoc;
end;