procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap:

 TBitmap);

var

 Header, Bits: Pointer;

 HeaderSize: Integer;

 BitsSize: Longint;

begin

 GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);

 Header := MemAlloc(HeaderSize);

 Bits := MemAlloc(BitsSize);

 try

  GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);

  StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.,

  DestRect.Right, DestRect.Bottom,

  0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),

  DIB_RGB_COLORS, SRCCOPY);

{ вам может понадобиться цветовой стандарт DIB_PAL_COLORS,

но это уже выходит за рамки моих знаний. }

 finally

  MemFree(Header, HeaderSize);

  MemFree(Bits, BitsSize);

 end;

end;

{ Печатаем изображение, растягивая его до целого листа }

procedure PrintBitmap(ABitmap: TBitmap);

var

 relheight, relwidth: integer;

begin

 screen.cursor := crHourglass;

 Printer.BeginDoc;

 if ((ABitmap.width / ABitmap.height) > l(printer.pagewidth / printer.pageheight)) then

  begin

{ Растягиваем ширину изображения до ширины бумаги }

  relwidth := printer.pagewidth;

  relheight := MulDiv(ABitmap.height, printer.pagewidth, ABitmap.width);

  end

 else

  begin

{ Растягиваем высоту изображения до высоты бумаги }

  relwidth := MulDiv(ABitmap.width, printer.pageheight, ABitmap.height);

  relheight := printer.pageheight;

  end;

 DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap);

 Printer.EndDoc;

 screen.cursor := crDefault;

end;