Contributor: PETER VAN LONKHUYZEN


unit Rawprint;

interface
uses printers,windows;

type TRawprinter =class(TPrinter)
                  public
                    dc2 : HDC;
                    aborted : boolean;
                    printing : boolean;
                    lasttime : integer;
                    procedure abort;
                    function startraw : boolean;
                    function endraw: boolean;
                    function write(s : string): boolean;
                    function writeln: boolean;
                    destructor destroy; override;
                    procedure settimer;
                    function printerror : boolean;
                  end;
implementation
uses sysutils,forms,dialogs,controls;

procedure TRawPrinter.settimer;
begin
  lasttime:=gettickcount;
end;

function TRawPrinter.printerror : boolean;
var r : integer;
begin
  result:=false;
  if (gettickcount>lasttime+15000) or (gettickcount0 then
    deletedc(dc2);
end;

function TRawprinter.startraw:boolean;
var
  CTitle: array[0..31] of Char;
  CMode : Array[0..4] of char;
  DocInfo: TDocInfo;
  r : integer;
begin
  result:=false;
  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
    if dc2=0 then
    begin
      DC2 := CreateDC(PChar(Driver), PChar(Device), PChar(Port), nil);
      if dc2=0 then
      begin
        result:=false;
        exit;
      end;
     SetAbortProc(dc2, AbortProc);
   end;
  end;
  settimer;
  aborted:=false;
  repeat
    application.processmessages;
  until (StartDoc(dc2, DocInfo)>0) or printerror;
  if not aborted then
    printing:=true;
  result:=printing;
end;

function TRawprinter.endraw : boolean;
begin
  settimer;
  if not aborted and printing then
  repeat
    application.processmessages;
  until (windows.enddoc(dc2)>0) or printerror;
  printing:=false;
  result:=not aborted;
end;

type passrec = packed record
                 l : word;
                 s : Array[0..255] of char;
               end;
var pass : Passrec;
function TRawprinter.write(s : string):boolean;
var tmp : string;
begin
result:=false;
  if not aborted and printing then
  while s<>'' do
  begin
    result:=false;
    tmp:=copy(s,1,255);
    delete(s,1,255);
    pass.l:=length(tmp);
    strpcopy(pass.s,tmp);
    settimer;
    repeat
      application.processmessages
    until (escape(dc2,PASSTHROUGH,0,@pass,nil)>=0) or printerror;
    if aborted then
      break;
    result:=true;
  end;
end;

function TRawprinter.writeln : boolean;
begin
  pass.l:=2;
  strpcopy(pass.s,#13#10);
  settimer;
  repeat
    application.processmessages
  until (escape(dc2,PASSTHROUGH,0,@pass,nil)>=0) or printerror;
  result:=not aborted;
end;

end.