How to print bitmaps

Problem/Question/Abstract:

How to print bitmaps

Answer:

I use this function for printing bitmaps and it has never failed so far. R is the restangle on the printer canvas that the printout must fit in:


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;