Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
// Дальше пишем текст (+ESC команды!!!!) прямо в Stream
// и не забываем переводить в DOS – кодировку
………
………
Stream.Free;
//Постановка задания в очередь – только теперь принтер начинает печатать
ScheduleJob(FPrinterHandle,FJob.JobID);
FreeMem(FJob);
ClosePrinter(FPrinterHandle);
end;
FreeMem(FDevice, 128);
FreeMem(FDriver, 128);
FreeMem(FPort, 128);
end;
С уважением, Оргиш Александр
Лучший способ печати формы
Данный документ содержит подробное описание способа печати содержимого формы: получение отдельных битов устройства при 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;
Как мне отправить на принтер чистый поток данных?
Nomadic советует:
Под Win16 Вы можете использовать функцию SpoolFile, или Passthrough escape, если принтер поддерживает последнее.
Под Win32 Вы можете использовать WritePrinter.
Ниже пример открытия принтера и записи чистого потока данных в принтер.
Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP", чтобы функция сработала успешно.
Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться.
uses WinSpool;
procedure WriteRawStringToPrinter(PrinterName: String; S: String);
var
Handle: THandle;
N: DWORD;
DocInfo1: TDocInfo1;
begin
if not OpenPrinter(PChar(PrinterName), Handle, nil) then begin
ShowMessage('error ' + IntToStr(GetLastError));
Exit;
end;
with DocInfo1 do begin
pDocName := PChar('test doc');
pOutputFile := nil;
pDataType := 'RAW';
end;
StartDocPrinter(Handle, 1, @DocInfo1);
StartPagePrinter(Handle);
WritePrinter(Handle, PChar(S), Length(S), N);
EndPagePrinter(Handle);
EndDocPrinter(Handle);
ClosePrinter(Handle);
