Советы по Delphi. Версия 1.4.3 от 1.1.2001

 {заполняем dib-структуру информацией, которая нам необходима в 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 := form1.width;

 PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;

 PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

 {узнаем сколько памяти необходимо для битов}

 GetDIBits(dc, MemBitmap, 0, form1.height, nil, TBitmapInfo(pDibHeader^), DIB_RGB_COLORS);

 {Распределяем память для битов}

 hBits := GlobalAlloc(GHND, PBitmapInfoHeader(pDibHeader)^.BiSizeImage);

 {Получаем указатель на биты}

 pBits := GlobalLock(hBits);

 {Вызываем функцию снова, но на этот раз нам передают биты!}

 GetDIBits(dc, MemBitmap, 0, form1.height, pBits, PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS);

 {Пробуем исправить ошибки некоторых видеодрайверов}

 if isDcPalDevice = true then begin

  for i := 0 to (pPal^.PalNumEntries - 1) do begin

   PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed := pPal^.palPalEntry[i].peRed;

   PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen := pPal^.palPalEntry[i].peGreen;

   PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue := pPal^.palPalEntry[i].peBlue;

  end;

  FreeMem(pPal, sizeof(TLOGPALETTE) +(255 * sizeof(TPALETTEENTRY)));

 end;

 {Освобождаем dc экрана}

 ReleaseDc(0, dc);

 {Удаляем изображение}

 DeleteObject(MemBitmap);

 {Запускаем работу печати}

 Printer.BeginDoc;

 {Масштабируем размер печати}

 if Printer.PageWidth < Printer.PageHeight then begin

  ScaleX := Printer.PageWidth;

  ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);

 end else begin

  ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);

  ScaleY := Printer.PageHeight;

 end;

 {Просто используем драйвер принтера для устройства палитры}

 isDcPalDevice := false;

 if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE then begin

  {Создаем палитру для 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)));