Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как распечатать BMP?

01.01.2007
procedure StretchPrint(R: TRect; ABitmap: Graphics.TBitmap);
var
  dc
: HDC;
  isDcPalDevice
: Bool;
  hDibHeader
: THandle;
  pDibHeader
: pointer;
  hBits
: THandle;
  pBits
: pointer;
  ppal
: PLOGPALETTE;
  pal
: hPalette;
 
Oldpal: hPalette;
  i
: integer;
begin
  pal
:= 0;
 
OldPal := 0;
 
{Get the screen dc}
  dc
:= GetDc(0);
 
{Allocate memory for a DIB structure}
  hDibHeader
:= GlobalAlloc(GHND, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256));
 
{get a pointer to the alloced memory}
  pDibHeader
:= GlobalLock(hDibHeader);
 
{fill in the dib structure with info on the way we want the DIB}
 
FillChar(pDibHeader^, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256), #0);
  PBITMAPINFOHEADER
(pDibHeader)^.biSize := sizeof(TBITMAPINFOHEADER);
  PBITMAPINFOHEADER
(pDibHeader)^.biPlanes := 1;
  PBITMAPINFOHEADER
(pDibHeader)^.biBitCount := 8;
  PBITMAPINFOHEADER
(pDibHeader)^.biWidth := ABitmap.width;
  PBITMAPINFOHEADER
(pDibHeader)^.biHeight := ABitmap.height;
  PBITMAPINFOHEADER
(pDibHeader)^.biCompression := BI_RGB;
 
{find out how much memory for the bits}
 
GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, nil, TBitmapInfo(pDibHeader^),
    DIB_RGB_COLORS
);
 
{Alloc memory for the bits}
  hBits
:= GlobalAlloc(GHND, PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
 
{Get a pointer to the bits}
  pBits
:= GlobalLock(hBits);
 
{Call fn again, but this time give us the bits!}
 
GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, pBits, PBitmapInfo(pDibHeader)^,
    DIB_RGB_COLORS
);
 
{Release the screen dc}
 
ReleaseDc(0, dc);
 
{Just incase the printer drver is a palette device}
  isDcPalDevice
:= false;
 
if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE then
 
begin
   
{Create palette from dib}
   
GetMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
   
FillChar(pPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
    pPal
^.palVersion := $300;
    pPal
^.palNumEntries := 256;
   
for i := 0 to (pPal^.PalNumEntries - 1) do
   
begin
      pPal
^.palPalEntry[i].peRed := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
      pPal
^.palPalEntry[i].peGreen := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
      pPal
^.palPalEntry[i].peBlue := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
   
end;
    pal
:= CreatePalette(pPal^);
   
FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
    oldPal
:= SelectPalette(Printer.Canvas.Handle, Pal, false);
    isDcPalDevice
:= true
 
end;
 
{send the bits to the printer}
 
StretchDiBits(Printer.Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
    R
.Bottom - R.Top, 0, 0, ABitmap.Width, ABitmap.Height, pBits,
   
PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS, SRCCOPY);
 
{Just incase you printer drver is a palette device}
 
if isDcPalDevice = true then
 
begin
   
SelectPalette(Printer.Canvas.Handle, oldPal, false);
   
DeleteObject(Pal);
 
end;
 
{Clean up allocated memory}
 
GlobalUnlock(hBits);
 
GlobalFree(hBits);
 
GlobalUnlock(hDibHeader);
 
GlobalFree(hDibHeader);
end;

Взято с Delphi Knowledge Base: https://www.baltsoft.com/