Печать в порт принтера

Материал из DRKB


Вариант 1[править | править код]

procedure TForm1.Button1Click(Sender: TObject);
var
  port, prnfile: file;
  buffer: array [1..128] of Char;
  Read: Integer;
begin
  // Specify a file to print
  AssignFile(prnfile, 'filetoprint');
  Reset(prnfile, 1);
  // specify printer port
  AssignFile(port, 'LPT1');
  Rewrite(port, 1);
  repeat
    BlockRead(prnfile, buffer, SizeOf(buffer), Read);
    BlockWrite(port, buffer, Read);
    // Application.ProcessMessages;
  until EOF(prnfile) or (Read <> SizeOf(buffer));
  CloseFile(prnfile);
  CloseFile(port);
end;


Вариант 2[править | править код]

{
  Question:
  How do I write a raw string of a data to the printer?

  The following unit "PrtRaw.pas" demonstrates a 16/32 bit
  raw printing unit for Delphi and Borland C Builder.

  Following the unit, is an exmaple on using the
  PrtRaw unit.

  Notes:

  1) You are responsible for embedding all necessary
  control codes that the printer may require (including
  form feed codes).

  2) You must specify a valid printer and port name.

}

unit PrtRaw;

{ Copyright (c) 1998 by Joe C. Hecht - All rights Reserved }
{ joehecht@gte.net You may use and share this unit }
{ providing my name and the copyright notice stays intact. }

interface

uses
  WinTypes;

{$IFDEF WIN32}
type
  SpoolInt = DWORD;
{$ELSE}
type
  SpoolInt = integer;

{$ENDIF}

function StartRawPrintJob(PrinterName: PChar; Port: PChar; DocName: PChar): THandle;
function StartRawPrintPage(hPrn: THandle): integer;
function PrintRawData(hPrn: THandle; Buffer: Pointer; NumBytes: SpoolInt): integer;
function EndRawPrintPage(hPrn: THandle): integer;
function EndRawPrintJob(hPrn: THandle): integer;


implementation

uses
  WinProcs
{$IFDEF WIN32}
  , WinSpool
{$ELSE}
  , Print
{$ENDIF}  ;

function StartRawPrintJob(PrinterName: PChar; Port: PChar;
  DocName: PChar): THandle;
{$IFDEF WIN32}
var
  hPrn: THandle;
  DocInfo1: TDocInfo1;
{$ENDIF}
begin
{$IFDEF WIN32}
  if (OpenPrinter(PChar(PrinterName), hPrn, nil) = False) then
  begin
    Result := THandle(-1);
    Exit;
  end;
  DocInfo1.pDocName := DocName;
  DocInfo1.pOutputFile := Port;
  DocInfo1.pDataType := 'RAW';
  if (StartDocPrinter(hPrn, 1, @DocInfo1) = 0) then
  begin
    Result := THandle(-1);
    Exit;
  end;
  Result := hPrn;
{$ELSE}
  Result := OpenJob(Port, DocName, 0);
{$ENDIF}
end;

function StartRawPrintPage(hPrn: THandle): Integer;
begin
{$IFDEF WIN32}
  if (StartPagePrinter(hPrn) = False) then
  begin
    Result := -1;
    Exit;
  end;
  Result := 1;
{$ELSE}
  Result := StartSpoolPage(hPrn);
{$ENDIF}
end;


function PrintRawData(hPrn: THandle; Buffer: Pointer; NumBytes: SpoolInt): Integer;
{$IFDEF WIN32}
var
  BytesWritten: DWORD;
{$ENDIF}
begin
  if (NumBytes = 0) then
  begin
    Result := 1;
    Exit;
  end;
{$IFDEF WIN32}
  if (WritePrinter(hPrn, Buffer, NumBytes, BytesWritten) = False) then
  begin
    Result := -1;
    Exit;
  end;
  if (NumBytes <> BytesWritten) then
  begin
    Result := -1;
    Exit;
  end;
  Result := 1;
{$ELSE}
  Result := WriteSpool(hPrn, Buffer, NumBytes);
{$ENDIF}
end;


function EndRawPrintPage(hPrn: THandle): Integer;
begin
{$IFDEF WIN32}
  if (EndPagePrinter(hPrn) = False) then
  begin
    Result := -1;
    Exit;
  end;
  Result := 1;
{$ELSE}
  Result := EndSpoolPage(hPrn);
{$ENDIF}
end;


function EndRawPrintJob(hPrn: THandle): Integer;
begin
{$IFDEF WIN32}
  if (EndDocPrinter(hPrn) = False) then
  begin
    Result := -1;
    Exit;
  end;
  if (ClosePrinter(hPrn) = False) then
  begin
    Result := -1;
    Exit;
  end;
  Result := 1;
{$ELSE}
  Result := CloseJob(hPrn);
{$ENDIF}
end;


end.


// Example of use:

uses
  PrtRaw;

procedure TForm1.Button1Click(Sender: TObject);
var
  hPrn : THandle;
  Data : array[0..31] of Char;
begin
  hPrn := StartRawPrintJob('Generic / Text Only', 'LPT1:', 'My Document');
  if (Integer(hPrn) < 0) then
  begin
    ShowMessage('StartRawPrintJob Failed');
    Exit;
  end;

  if (StartRawPrintPage(hPrn) < 0) then
  begin
    ShowMessage('StartRawPrintPage Failed');
    EndRawPrintJob(hPrn);
    Exit;
  end;

  Data[0] := 'P';
  Data[1] := 'a';
  Data[2] := 'g';
  Data[3] := 'e';
  Data[4] := #32;
  Data[5] := '1';
  Data[6] := #13;
  Data[7] := #10;

  if (PrintRawData(hPrn, @data, 8) < 0) then
  begin
    ShowMessage('PrintRawData Failed');
    EndRawPrintPage(hPrn);
    EndRawPrintJob(hPrn);
    Exit;
  end;

  if (EndRawPrintPage(hPrn) < 0) then
  begin
    ShowMessage('EndRawPrintPage Failed');
    EndRawPrintJob(hPrn);
    Exit;
  end;

  if (StartRawPrintPage(hPrn) < 0) then
  begin
    ShowMessage('StartRawPrintPage Failed');
    EndRawPrintJob(hPrn);
    Exit;
  end;
  Data[0] := 'P';
  Data[1] := 'a';
  Data[2] := 'g';
  Data[3] := 'e';
  Data[4] := #32;
  Data[5] := '2';
  Data[6] := #13;
  Data[7] := #10;

  if (PrintRawData(hPrn, @data, 8) < 0) then
  begin
    ShowMessage('PrintRawData Failed');
    EndRawPrintPage(hPrn);
    EndRawPrintJob(hPrn);
    Exit;
  end;

  if (EndRawPrintPage(hPrn) < 0) then
  begin
    ShowMessage('EndRawPrintPage Failed');
    EndRawPrintJob(hPrn);
    Exit;
  end;

  if (EndRawPrintJob(hPrn) < 0) then
  begin
    ShowMessage('EndRawPrintJob Failed');
    Exit;
  end;

end;

end.



Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03252