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

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

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

---

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 WriteRawStringToPrinter('HP', 'Test This');

end;

Посмотри и доделай как тебе надо.

unit TextPrinter;

interface

uses Windows, Controls, Forms, Dialogs;

type TTextPrinter = class(TObject)

private

 FNumberOfBytesWritten: Integer;

 FHandle: THandle;

 FPrinterOpen: Boolean;

 FErrorString: PChar;

 procedure SetErrorString;

public

 constructor Create;

 procedure Write(const Str: string);

 procedure WriteLn(const Str: string);

 destructor Destroy; override;

published

 property NumberOfBytesWritten: Integer read FNumberOfBytesWritten;

end;

implementation

{TTextPrinter}

constructor TTextPrinter.Create;

begin

 FHandle := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);

 if FHandle = INVALID_HANDLE_VALUE then begin

  SetErrorString;

  raise Exception.Create(FErrorString);

 end else FPrinterOpen := True;

end;

procedure TTextPrinter.SetErrorString;

begin

 if FErrorString <> nil then LocalFree(Integer(FErrorString));

 FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(),

LANG_USER_DEFAULT, @FErrorString, 0, nil);

end;

procedure TTextPrinter.Write(const Str: string);

var

 OEMStr: PChar;

 NumberOfBytesToWrite: Integer;

begin

 if not FPrinterOpen then Exit;

 NumberOfBytesToWrite := Length(Str);

 OEMStr := PChar(LocalAlloc(LMEM_FIXED, NumberOfBytesToWrite + 1));

 try

  CharToOem(PChar(Str), OEMStr);

  if not WriteFile(FHandle, OEMStr^, NumberOfBytesToWrite, FNumberOfBytesWritten, nil) then begin

   SetErrorString;

   raise Exception.Create(FErrorString);

  end;

 finally

  LocalFree(Integer(OEMStr));

 end;

end;

procedure TTextPrinter.WriteLn(const Str: string);

begin

 Self.Write(Str);

 Self.Write(#10);

end;

destructor TTextPrinter.Destroy;

begin

 CloseHandle(FHandle);

 if FErrorString  <> nil then LocalFree(Integer(FErrorString));

end;

end.

P.S. В принципе, вместо LPT1 может стоять что угодно, даже сетевой сервер печати (\\server\prn) – все равно печатает. Можно и параметр в конструктор вставить и т.д.

Как правильно печатать любую информацию (растровые и векторные изображения), а также как сделать режим предварительного просмотра?

Nomadic советует:

Маленькое предисловие.

Т.к. основная моя работа связана с написанием софта для института, обрабатывающего геоданные, то и в отделе, где pаботаю, так же мучаются проблемами печати (в одном случае — надо печатать карты, с изолиниями, заливкой, подписями и пр.; в другом случае — свои таблицы и сложные отрисовки по внешнему виду).

В итоге, моим коллегой был написан кусок, в котором ему удалось добиться качественной печати в двух режимах : MetaFile, Bitmap.

Работа с MetaFile у нас сложилась уже исторически — достаточно удобно описать ф-цию, которая что-то отрисовывает (хоть на экране, хоть где), которая принимает TCanvas, и подсовывать ей то канвас дисплея, то канвас метафайла, а потом этот Metafile выбрасывать на печать. Достаточно решить лишь проблемы масштабирования, после чего — вперед.

Главная головная боль при таком методе — при отрисовке больших кусков, которые занимают весь лист или его большую часть, надо этот метафайл по размерам делать сразу же в пикселах на этот самый лист. Тогда при изменении размеров (просмотр перед печатью) — искажения при уменьшении не кpритичны, а вот при увеличении линии и шрифты не "поползут".

Итак:

Hабор идей, котоpые были написаны (с) Андреем Аристовым, программистом отдела матобеспечения СибНИИНП, г. Тюмень. Моего здесь только — приделывание сверху надстроек для личного использования.

Вся работа сводится к следующим шагам :

1. Получить необходимые коэф-ты;

2. Построить метафайл или bmp для последующего вывода на печать;

3. Hапечатать.

Hиже приведенный кусок (прошу меня не пинать, но писал я и писал для достаточно кривой реализации с передачей параметров через глобальные переменные) я использую для того, чтобы получить коэф-ты пересчета.

kScale — для пересчета размеров шрифта, а потом уже закладываюсь на его размеры и получаю два новых коэф-та для kW, kH — которые и позволяют мне с учетом высоты шрифта выводить графику и пр. У меня при работе kW <> kH, что приходится учитывать.

Решили пункт 1.

procedure SetKoeffMeta; // установить коэф-ты

var

 PrevMetafile : TMetafile;

 MetaCanvas : TMetafileCanvas;

begin

 PrevMetafile := nil;

 MetaCanvas := nil;

 try

  PrevMetaFile := TMetaFile.Create;

  try

   MetaCanvas := TMetafileCanvas.Create(PrevMetafile, 0);

   kScale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / Screen.PixelsPerInch;

   MetaCanvas.Font.Assign(oGrid.Font);

   MetaCanvas.Font.Size := Round(oGrid.Font.Size * kScale);

   kW := MetaCanvas.TextWidth('W') / oGrid.Canvas.TextWidth('W');

   kH := MetaCanvas.TextHeight('W') / oGrid.Canvas.TextHeight('W');

  finally

   MetaCanvas.Free;

  end;

 finally

  PrevMetafile.Free;

 end;

end;

Решаем 2.

…

var

 PrevMetafile : TMetafile;

 MetaCanvas : TMetafileCanvas;

begin

 PrevMetafile := nil;

 MetaCanvas := nil;

 try

  PrevMetaFile := TMetaFile.Create;

  PrevMetafile.Width := oWidth;

  PrevMetafile.Height := oHeight;

  try

   MetaCanvas := TMetafileCanvas.Create(PrevMetafile, 0);

   // здесь должен быть ваш код - с учетом масштабиpования.

   // я эту вещь вынес в ассигнуемую пpоцедуpу, и данный блок

   // вызываю лишь для отpисовки целой стpаницы.

   см. PS1.

  finally

   MetaCanvas.Free;

  end;

  ...

  PS1. Код, котоpый используется для отpисовки. oCanvas - TCanvas метафайла.

  ...

var iHPage : integer; // высота страницы

begin

 with oCanvas do begin

  iHPage := 3000;

  // залили область метайфайла белым - для дальнейшей pаботы

  Pen.Color := clBlack;

  Brush.Color := clWhite;

  FillRect(Rect(0, 0, 2000, iHPage));

  // установили шpифты - с учетом их дальнейшего масштабиpования

  oCanvas.Font.Assign(oGrid.Font);

  oCanvas.Font.Size := Round(oGrid.Font.Size * kScale);

  ...

  xEnd := xBegin;

  iH := round(RowHeights[iRow] * kH);

  for iCol := 0 to ColCount - 1 do begin

   x := xEnd;

   xEnd := x + round(ColWidths[iCol] * kW);

   Rectangle(x, yBegin, xEnd, yBegin + iH);

   r := Rect(x + 1, yBegin + 1, xEnd – 1, yBegin + iH – 1);

   s := Cells[iCol, iRow];

   // выписали в полученный квадрат текст

   DrawText(oCanvas.Handle, PChar(s), Length(s), r, DT_WORDBREAK or dt_center);

Главное, что важно помнить на этом этапе – это не забывать, что все выводимые объекты должны пользоваться описанными коэф-тами (как вы их получите – это уже ваше дело). В данном случае – я работаю с пеpеделанным TStringGrid, который сделал для многостраничной печати. Последний пункт – надо сформированный метафайл или bmp напечатать.

…

var

 Info: PBitmapInfo;

 InfoSize: Integer;

 Image: Pointer;

 ImageSize: DWORD;

 Bits: HBITMAP;

 DIBWidth, DIBHeight: Longint;

 PrintWidth, PrintHeight: Longint;

begin

 ...

 case ImageType of

 itMetafile:

  begin

   if Picture.Metafile<>nil then Printer.Canvas.StretchDraw(Rect(aLeft, aTop, aLeft+fWidth, aTop+fHeight), Picture.Metafile);

  end;

 itBitmap:

  begin