Author: Tomas Rutkauskas

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:

1   
2   procedure StretchPrint(R: TRect; ABitmap: Graphics.TBitmap);
3   var
4     dc: HDC;
5     isDcPalDevice: Bool;
6     hDibHeader: THandle;
7     pDibHeader: pointer;
8     hBits: THandle;
9     pBits: pointer;
10    ppal: PLOGPALETTE;
11    pal: hPalette;
12    Oldpal: hPalette;
13    i: integer;
14  begin
15    pal := 0;
16    OldPal := 0;
17    {Get the screen dc}
18    dc := GetDc(0);
19    {Allocate memory for a DIB structure}
20    hDibHeader := GlobalAlloc(GHND, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256));
21    {get a pointer to the alloced memory}
22    pDibHeader := GlobalLock(hDibHeader);
23    {fill in the dib structure with info on the way we want the DIB}
24    FillChar(pDibHeader^, sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256), #0);
25    PBITMAPINFOHEADER(pDibHeader)^.biSize := sizeof(TBITMAPINFOHEADER);
26    PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
27    PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
28    PBITMAPINFOHEADER(pDibHeader)^.biWidth := ABitmap.width;
29    PBITMAPINFOHEADER(pDibHeader)^.biHeight := ABitmap.height;
30    PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;
31    {find out how much memory for the bits}
32    GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, nil, TBitmapInfo(pDibHeader^),
33      DIB_RGB_COLORS);
34    {Alloc memory for the bits}
35    hBits := GlobalAlloc(GHND, PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
36    {Get a pointer to the bits}
37    pBits := GlobalLock(hBits);
38    {Call fn again, but this time give us the bits!}
39    GetDIBits(dc, ABitmap.Handle, 0, ABitmap.height, pBits, PBitmapInfo(pDibHeader)^,
40      DIB_RGB_COLORS);
41    {Release the screen dc}
42    ReleaseDc(0, dc);
43    {Just incase the printer drver is a palette device}
44    isDcPalDevice := false;
45    if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE 
46  then
47    begin
48      {Create palette from dib}
49      GetMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
50      FillChar(pPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
51      pPal^.palVersion := $300;
52      pPal^.palNumEntries := 256;
53      for i := 0 to (pPal^.PalNumEntries - 1) do
54      begin
55        pPal^.palPalEntry[i].peRed := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
56        pPal^.palPalEntry[i].peGreen := 
57  PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
58        pPal^.palPalEntry[i].peBlue := PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
59      end;
60      pal := CreatePalette(pPal^);
61      FreeMem(pPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
62      oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
63      isDcPalDevice := true
64    end;
65    {send the bits to the printer}
66    StretchDiBits(Printer.Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
67      R.Bottom - R.Top, 0, 0, ABitmap.Width, ABitmap.Height, pBits,
68      PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS, SRCCOPY);
69    {Just incase you printer drver is a palette device}
70    if isDcPalDevice = true then
71    begin
72      SelectPalette(Printer.Canvas.Handle, oldPal, false);
73      DeleteObject(Pal);
74    end;
75    {Clean up allocated memory}
76    GlobalUnlock(hBits);
77    GlobalFree(hBits);
78    GlobalUnlock(hDibHeader);
79    GlobalFree(hDibHeader);
80  end;