Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:

Error. Page cannot be displayed. Please contact your service provider for more details. (18)


Подробное описание способа печати содержимого формы

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

Кроме того, в данном коде осуществляется проверка палитры устройства (экран или принтер), и включается обработка палитры соответствующего устройства. Если устройством палитры является устройство экрана, принимаются дополнительные меры по заполнению палитры растрового изображения из системной палитры, избавляющие от некорректного заполнения палитры некоторыми видеодрайверами.

Примечание: Поскольку данный код делает снимок формы, форма должна располагаться на самом верху, поверх остальных форм, быть полность на экране, и быть видимой на момент ее "съемки".

Код

unit Prntit;

interface

uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
 Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Image1: TImage;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var

 dc: HDC;
 isDcPalDevice: BOOL;
 MemDc: hdc;
 MemBitmap: hBitmap;
 OldMemBitmap: hBitmap;
 hDibHeader: Thandle;
 pDibHeader: pointer;
 hBits: Thandle;
 pBits: pointer;
 ScaleX: Double;
 ScaleY: Double;
 ppal: PLOGPALETTE;
 pal: hPalette;
 Oldpal: hPalette;
 i: integer;
begin

 {Получаем dc экрана}
 dc := GetDc(0);
 {Создаем совместимый dc}
 MemDc := CreateCompatibleDc(dc);
 {создаем изображение}
 MemBitmap := CreateCompatibleBitmap(Dc,
   form1.width,
   form1.height);
 {выбираем изображение в dc}
 OldMemBitmap := SelectObject(MemDc, MemBitmap);

 {Производим действия, устраняющие ошибки при работе с некоторыми типами видеодрайверов}
 isDcPalDevice := false;
 if GetDeviceCaps(dc, RASTERCAPS) and
   RC_PALETTE = RC_PALETTE then
 begin
   GetMem(pPal, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)));
   FillChar(pPal^, sizeof(TLOGPALETTE) +
     (255 * sizeof(TPALETTEENTRY)), #0);
   pPal^.palVersion := $300;
   pPal^.palNumEntries :=
     GetSystemPaletteEntries(dc,
     0,
     256,
     pPal^.palPalEntry);
   if pPal^.PalNumEntries <> 0 then
   begin
     pal := CreatePalette(pPal^);
     oldPal := SelectPalette(MemDc, Pal, false);
     isDcPalDevice := true
   end
   else
     FreeMem(pPal, sizeof(TLOGPALETTE) +
       (255 * sizeof(TPALETTEENTRY)));
 end;

 {копируем экран в memdc/bitmap}
 BitBlt(MemDc,
   0, 0,
   form1.width, form1.height,
   Dc,
   form1.left, form1.top,
   SrcCopy);

 if isDcPalDevice = true then
 begin
   SelectPalette(MemDc, OldPal, false);
   DeleteObject(Pal);
 end;

 {удаляем выбор изображения}
 SelectObject(MemDc, OldMemBitmap);
 {удаляем dc памяти}
 DeleteDc(MemDc);
 {Распределяем память для структуры DIB}
 hDibHeader := GlobalAlloc(GHND,
   sizeof(TBITMAPINFO) +
   (sizeof(TRGBQUAD) * 256));
 {получаем указатель на распределенную память}
 pDibHeader := GlobalLock(hDibHeader);

 {заполняем 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)));
   oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
   isDcPalDevice := true
 end;

 {посылаем биты на принтер}
 StretchDiBits(Printer.Canvas.Handle,
   0, 0,
   Round(scaleX), Round(scaleY),
   0, 0,
   Form1.Width, Form1.Height,
   pBits,
   PBitmapInfo(pDibHeader)^,
   DIB_RGB_COLORS,
   SRCCOPY);

 {Просто используем драйвер принтера для устройства палитры}
 if isDcPalDevice = true then
 begin
   SelectPalette(Printer.Canvas.Handle, oldPal, false);
   DeleteObject(Pal);
 end;

 {Очищаем распределенную память} GlobalUnlock(hBits);
 GlobalFree(hBits);
 GlobalUnlock(hDibHeader);
 GlobalFree(hDibHeader);

 {Заканчиваем работу печати}
 Printer.EndDoc;

end;

Автор: DRKB
Сайт: http://delphiworld.narod.ru






Просмотров: 2082

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную