Подробное описание способа печати содержимого формы
Материал из DRKB
Данный документ содержит подробное описание способа печати содержимого формы: получение отдельных битов устройства при 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;
Source: Взято с http://delphiworld.narod.ru
ID: 03253