Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

  // Дальше пишем текст (+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);