|
Данный документ содержит подробное описание способа печати содержимого формы: получение отдельных битов устройства при 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 < sizeof(TLOGPALETTE) cla(pPal,> (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; |