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

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., R.Right - R.Left,
  R.Bottom - R., 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: http://www.baltsoft.com/

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...