Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Распечатать файл через порт принтера 2

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch


 { 
  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] := ' ';
   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] := ' ';
   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.
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.