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

ifisDcPalDevice = 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", чтобы функция сработала успешно.

Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться.

usesWinSpool;

procedureWriteRawStringToPrinter(PrinterName: String; S: String);

var

Handle: THandle;

N: DWORD;

DocInfo1: TDocInfo1;

begin

if notOpenPrinter(PChar(PrinterName), Handle, nil) then begin

ShowMessage('error ' + IntToStr(GetLastError));

Exit;

end;

withDocInfo1 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);

end;

procedureTForm1.Button1Click(Sender: TObject);

begin

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

end;

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

unitTextPrinter;

interface

usesWindows, Controls, Forms, Dialogs;

typeTTextPrinter = class(TObject)

private

FNumberOfBytesWritten: Integer;

FHandle: THandle;

FPrinterOpen: Boolean;

FErrorString: PChar;

procedure SetErrorString;

public

constructorCreate;

procedureWrite( constStr: string);

procedureWriteLn( constStr: string);

destructorDestroy; override;

published

propertyNumberOfBytesWritten: Integer readFNumberOfBytesWritten;

end;

implementation

{TTextPrinter}

constructorTTextPrinter.Create;

begin

FHandle := CreateFile('LPT1', GENERIC_READ orGENERIC_WRITE, FILE_SHARE_READ orFILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);

ifFHandle = INVALID_HANDLE_VALUE then begin

SetErrorString;

raiseException.Create(FErrorString);

end else FPrinterOpen := True;

end;

procedureTTextPrinter.SetErrorString;

begin

ifFErrorString <> nil thenLocalFree(Integer(FErrorString));

FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER orFORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(),

LANG_USER_DEFAULT, @FErrorString, 0, nil);

end;

procedureTTextPrinter.Write( constStr: string);

var

OEMStr: PChar;

NumberOfBytesToWrite: Integer;

begin

if notFPrinterOpen thenExit;

NumberOfBytesToWrite := Length(Str);

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

try

CharToOem(PChar(Str), OEMStr);

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

SetErrorString;

raiseException.Create(FErrorString);

end;

finally

LocalFree(Integer(OEMStr));

end;

end;

procedureTTextPrinter.WriteLn( constStr: string);

begin

Self.Write(Str);

Self.Write(#10);

end;

destructorTTextPrinter.Destroy;

begin

CloseHandle(FHandle);

ifFErrorString <> nil thenLocalFree(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.

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

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;