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

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аботаю, так же мучаются проблемами печати (в одном случае — надо печатать карты, с изолиниями, заливкой, подписями и пр.; в другом случае — свои таблицы и сложные отрисовки по внешнему виду).