Программирование Delphi

Пересылка точечного рисунка с экрана на принтер - недопустимая операция, которая потерпит неудачу, если драйвер печати не предназначен, чтобы обнаружить ошибку.

Это означает, что Вы должны использовать методы рисования Canvas такие, как StretchDraw, CopyRect, BrushCopy и т.д. для передачи точечного рисунка принтеру.

Единственный способ напечатать изображение состоит в том, чтобы использованть DIB. Получение правильного DIB может быть затруднено, но есть много функций API Windows, которые будут использоваться.

Следующий пример демонстрирует попытку преодолеть некоторые из этих проблем и ограничений. Пример должен работать правильно под всеми версиями Delphi/C++Builder.

Основная функция в примере - BltTBitmapAsDib(), которая получает дескриптор устройства для отображения и координаты X и Y, а также ширина и высота изображения.

Пример:

uses Printers;

type
  PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
  TPalEntriesArray = array[0..0] of TPaletteEntry;

procedure BltTBitmapAsDib(DestDc : hdc;   {Handle of where to blt}
                          x : word;       {Bit at x}
                          y : word;       {Blt at y}
                          Width : word;   {Width to stretch}
                          Height : word;  {Height to stretch}
                          bm : TBitmap);  {the TBitmap to Blt}
var
  OriginalWidth :LongInt;               {width of BM}
  dc : hdc;                             {screen dc}
  IsPaletteDevice : bool;               {if the device uses palettes}
  IsDestPaletteDevice : bool;           {if the device uses palettes}
  BitmapInfoSize : integer;             {sizeof the bitmapinfoheader}
  lpBitmapInfo : PBitmapInfo;           {the bitmap info header}
  hBm : hBitmap;                        {handle to the bitmap}
  hPal : hPalette;                      {handle to the palette}
  OldPal : hPalette;                    {temp palette}
  hBits : THandle;                      {handle to the DIB bits}
  pBits : pointer;                      {pointer to the DIB bits}
  lPPalEntriesArray : PPalEntriesArray; {palette entry array}
  NumPalEntries : integer;              {number of palette entries}
  i : integer;                          {looping variable}
begin

{$IFOPT R+}
  {$DEFINE CKRANGE}
  {$R-}
{$ENDIF}

{Сохраним оригинальную ширину точечного рисунка}
  OriginalWidth := bm.Width;

{Получить DC экрана, так как DC в памяти ненадежен}
  dc := GetDc(0);
{Палитра устройства?}
  IsPaletteDevice :=
    GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
{Вернуть DC экрана}
  dc := ReleaseDc(0, dc);

{Распределить BitmapInfo}
  if IsPaletteDevice then
    BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
  else
    BitmapInfoSize := sizeof(TBitmapInfo);
  GetMem(lpBitmapInfo, BitmapInfoSize);

{Заполнить нулями BitmapInfo}
  FillChar(lpBitmapInfo^, BitmapInfoSize, #0);

{Заполнить BitmapInfo}
  lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
  lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;
  lpBitmapInfo^.bmiHeader.biHeight := bm.Height;
  lpBitmapInfo^.bmiHeader.biPlanes := 1;
  if IsPaletteDevice then
    lpBitmapInfo^.bmiHeader.biBitCount := 8
  else
    lpBitmapInfo^.bmiHeader.biBitCount := 24;
  lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
  lpBitmapInfo^.bmiHeader.biSizeImage :=
    ((lpBitmapInfo^.bmiHeader.biWidth *
      longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *
      lpBitmapInfo^.bmiHeader.biHeight;
  lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
  lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
  if IsPaletteDevice then begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 256;
    lpBitmapInfo^.bmiHeader.biClrImportant := 256;
  end else begin
    lpBitmapInfo^.bmiHeader.biClrUsed := 0;
    lpBitmapInfo^.bmiHeader.biClrImportant := 0;
  end;

{Получить дескриптор точечного рисунка и палитры}
  hBm := bm.ReleaseHandle;
  hPal := bm.ReleasePalette;

Источник: delphi3000.com