Построчная печать

В Delphi 1 (а затем и в Delphi 2) я попытался написать программу, печатающую построчно на принтере (любого типа), после выхода из которой принтер НЕ выплевывает лист, а продолжает на нем печатать в случае повторного использования программы, то есть программа позволяет печатать строчку за строчкой, не удаляя при этом лист в случае завершения задачи.

Это противоречит неписанным законам Microsoft, поскольку нарушает режим многозадачности, и все же именно для моей задачи мне необходимо именно такое решение.

Я создал клон объекта TPrinter, назначение которого вы поймете ниже. Это работает со всеми матричными принтерами.

Вот пример объекта:

var

  Myprinter: TRawPrinter;
  oldprinter: TPrinter;
begin

  MyPrinter := TRawPrinter.Create;
  oldprinter := setprinter(MyPrinter);
  try

    if
 Printdialog1.execute then

    begin

      myprinter.startraw;
      myprinter.write('Delphi World is the best!');
      myprinter.writeln;
      myprinter.endraw;
    end

  finally

    setprinter(oldprinyter);
    myprinter.free;
  end

end
;

Вот пример использования объекта:

unit
 Rawprinter;

interface

uses
 printers, windows;

type

  TRawprinter = class
(TPrinter)

  public

    dc2: HDC;
    procedure
 startraw;
    procedure
 endraw;
    procedure
 write(const
 s: string
);
    procedure
 writeln;
  end
;

implementation

uses
 sysutils, forms;

function
 AbortProc(Prn: HDC; Error: Integer): Bool; stdcall
;
begin


  Application.ProcessMessages;
  Result := not
 Printer.Aborted;
end
;

type


  TPrinterDevice = class

    Driver, Device, Port: string
;
    constructor
 Create(ADriver, ADevice, APort: PChar);
    function
 IsEqual(ADriver, ADevice, APort: PChar): Boolean;
  end
;

constructor
 TPrinterDevice.Create(ADriver, ADevice, APort: PChar);
begin


  inherited
 Create;
  Driver := ADriver;
  Device := ADevice;
  Port := APort;
end
;

function
 TPrinterDevice.IsEqual(ADriver, ADevice, APort: PChar): Boolean;
begin


  Result := (Device = ADevice) and
 (Port = APort);
end
;

procedure
 TRawprinter.startraw;
var


  CTitle: array
[0..31] of
 Char;
  CMode: array
[0..4] of
 char;
  DocInfo: TDocInfo;
  r: integer;
begin


  StrPLCopy(CTitle, Title, SizeOf(CTitle) - 1);
  StrPCopy(CMode, 'RAW');
  FillChar(DocInfo, SizeOf(DocInfo), 0);
  with
 DocInfo do

  begin

    cbSize := SizeOf(DocInfo);
    lpszDocName := CTitle;
    lpszOutput := nil
;
    lpszDatatype := CMode;
  end
;
  with
 TPrinterDevice(Printers.Objects[PrinterIndex]) do

  begin

    DC2 := CreateDC(PChar(Driver), PChar(Device), PChar(Port), nil
);
  end
;
  SetAbortProc(dc2, AbortProc);
  r := StartDoc(dc2, DocInfo);
end
;

procedure
 TRawprinter.endraw;
var

  r: integer;
begin


  r := windows.enddoc(dc2);
end
;

type

  passrec = packed
 record


    l: word;
    s: array
[0..255] of
 char;
  end
;
var

  pass: Passrec;

procedure
 TRawprinter.write(const
 s: string
);
begin


  pass.l := length(s);
  strpcopy(pass.s, s);
  escape(dc2, PASSTHROUGH, 0, @pass, nil
);
end
;

procedure
 TRawprinter.writeln;
begin


  pass.l := 2;
  strpcopy(pass.s, #13#10);
  escape(dc2, PASSTHROUGH, 0, @pass, nil
);
end
;

end
.

Другое по теме:

• Escape код PASSTHROUGH
• Вместо печати графики использовать резидентный шрифт принтера
• Вывести все способы подачи бумаги для печати