Delphi 直接打印代码(不需要装打印机驱动)

转：https://bbs.csdn.net/topics/127642

{*******************************************************}
{                                                       }
{       Musicwind Delphi Development Package            }
{                DosPrinter Unit                        }
{                                                       }
{       Copyright ( c ) 2000,2005 Musicwind             }
{                                                       }
{ History:                                              }
{                                                       }
{    Build with Delphi5, Musicwind    [2000-03-??]      }
{                                                       }
{    TDosPrinter                                        }
{                                                       }
{*******************************************************}

unit DosPrinter;

//  Note: Only Be Ok in Win98, and the printer must be in
//        lpt1, lpt2 or lpt3;
//        And Be Sure your Windows does not install the printer
//
//  User Guide:   Just add this unit into the "uses" clause, then you may
//                call LPT1.Write, LPT1.WriteLn, LTP1.WriteFmt directly to
//                make output on the printer. (LPT2 is also supported).
//
//  Limitation:   This unit does not have error checking capabilities.

//  New added Guide:
//  TDosPrinter;
//       Can Check whether the printer is empty of paper, or
//       printer does not linked, or other errors.
//

interface

uses Classes, SysUtils, Windows, MusicSys;

type
  // 并口号
  TDosLptPort = ( dpLpt1, dpLpt2, dpLpt3 );

  // 错误类别, ( 未联机, 缺纸, 超时 ) 　
  TErrType = ( etLinkLost, etLackPaper, etTimeout );

  // 打印错误事件
  TErrMsgEvent = procedure(Sender: TObject; ErrType: TErrType;
                     var Retry: Boolean ) of object;

  TDosPrinter = class
  private
     FLptPort: TDosLptPort;
     FOnErr: TErrMsgEvent;
     FblActive: Boolean;
  protected

  public
     Constructor Create;

     procedure BeginDoc;
     procedure EndDoc;
     procedure DoDoubleWidth( bl: Boolean );
     procedure DoDoubleHeight( bl: Boolean );
     procedure DoBold( bl: Boolean );
     procedure ChineseMode;
     procedure DoExpress( bl: Boolean );
     procedure CR;
     procedure Writeln( sLine: string );
     procedure Write( sLine: string );
     function WriteChar( Achar: char ): Boolean;
     procedure MovePaper( iSize: integer );

     property Active: Boolean read FblActive;
     property LptPort: TDosLptPort read FLptPort write FLptPort;
     property OnErr: TErrMsgEvent read FOnErr write FOnErr;

  end;

function DosLpt1: TDosPrinter;
function DosLpt2: TDosPrinter;
  
implementation

var
   _DosLpt1: TDosPrinter = nil;
   _DosLpt2: TDosPrinter = nil;

function DosLpt1: TDosPrinter;
begin
   if not Assigned( _DosLpt1 ) then
   begin
      _DosLpt1 := TDosPrinter.Create;
      _DosLpt1.LptPort := dpLpt1;
   end;
   result := _DosLpt1;
end;

function DosLpt2: TDosPrinter;
begin
   if not Assigned( _DosLpt2 ) then
   begin
      _DosLpt2 := TDosPrinter.Create;
      _DosLpt2.LptPort := dpLpt2;
   end;
   result := _DosLpt2;
end;

{ TDosPrinter }

procedure TDosPrinter.BeginDoc;
begin
   // Do nothing ...
end;

procedure TDosPrinter.ChineseMode;
begin
   Write( #28 + '&' );
end;

procedure TDosPrinter.CR;
begin
   Write( #13 );
end;

constructor TDosPrinter.Create;
begin
   FLptPort := dpLpt1;
   FblActive := True;
end;

procedure TDosPrinter.DoBold(bl: Boolean);
begin
   if bl then
      Write( #27 + 'E' )
   else
      Write( #27 + 'F' );
end;

procedure TDosPrinter.DoDoubleHeight(bl: Boolean);
begin
   if bl then
      Write( #27 + 'w' + #1 )
   else
      Write( #27 + 'w' + #0 );
end;

procedure TDosPrinter.DoDoubleWidth(bl: Boolean);
begin
   if bl then
      Write( #27 + 'W' + #1 )
   else
      Write( #27 + 'W' + #0 );
end;

procedure TDosPrinter.DoExpress(bl: Boolean);
begin
   if bl then
      Write( #28 + 'x' + #1 )
   else
      Write( #28 + 'x' + #0 );
end;

procedure TDosPrinter.EndDoc;
begin
   // Do nothing ... 
end;

procedure TDosPrinter.MovePaper(iSize: integer);
begin
   Write( #27 + 'J' + char( iSize mod 255 ) );
end;

procedure TDosPrinter.Write(sLine: string);
var
  index: longint;
begin
  for Index := 1 to length( sLine ) do
     if not WriteChar( sLine[Index]  ) then
        Break;
end;

function TDosPrinter.WriteChar( AChar: char): Boolean;
var
   byteChar, byteStatus: Byte;
   wordLpt: Word;
   bPaperOut, bSelected, bIOError, bTimeOut, bOK: Boolean;
   // below is new added by Musicwind, 2001-02-08
   FErrType: TErrType;
   Retry: Boolean;
   dwTimeOut: DWORD;
begin
   result := False;

   if not mscIsWin98 then
   begin
      FblActive := result;
      Exit;
   end;

   byteChar := byte( AChar );
   if FLptPort = dpLpt1 then
      wordLpt := 0 else
   if FLptPort = dpLpt2 then
      wordLpt := 1 else
   if FLptPort = dpLpt3 then
      wordLpt := 2
   else
      wordLpt := 0;
   repeat
      retry := False;

      byteStatus := $40;
      while (( byteStatus and $80 ) = 0 ) and (( byteStatus and $40 ) <> 0 ) do
      asm
         MOV AH, 0
         MOV DX, wordLpt
         MOV AL, byteChar
         INT 17H
         MOV byteStatus, AH
      end;
         
      bTimeOut := ( byteStatus and $01 ) <> 0;
      bIOError := ( byteStatus and $08 ) <> 0;
      bSelected := ( byteStatus and $10 ) <> 0;
      bPaperOut := ( byteStatus and $20 ) <> 0;

      if bTimeOut then
         FErrType := etTimeOut
      else
      if bSelected and bPaperOut and bIOError then
         FErrType := etLackPaper
      else
      if bSelected and bPaperOut or bIOError then
         FErrType := etLinkLost
      else
      begin
         // Print content
         result := True;

      end;

      if not result then
      begin
         Retry := False;
         if Assigned( FOnErr ) then
         begin
            Retry := True;
            FOnErr( Self, FErrType, Retry );
         end;
      end;
   until result or not Retry;
   FblActive := result;
   if not FblActive then
      raise Exception.Create( '打印出错!' );
end;

procedure TDosPrinter.Writeln(sLine: string);
begin
   Write( sLine + #13#10 );
end;

initialization

finalization

end.



{*******************************************************}
{                                                       }
{       Musicwind Delphi Development Package            }
{                    Lpt Unit                           }
{                                                       }
{       Copyright ( c ) 2000,2005 Musicwind             }
{                                                       }
{ History:                                              }
{                                                       }
{    Build with Delphi5, Musicwind    [2000-12-18]      }
{                                                       }
{    TLpt
{    TLptStream
{    TEpson300K
{                                                       }
{*******************************************************}
unit LPT;

//  Note: Only Be Ok in WinNt or later OS
//        And Be Sure your Windows does not install the printer
//
//  User Guide:   Just add this unit into the "uses" clause, then you may
//                call LPT1.Write, LPT1.WriteLn, LTP1.WriteFmt directly to
//                make output on the printer. (LPT2 is also supported).
//
//  Limitation:   This unit does not have error checking capabilities.

//  New added Guide:
//  TEpson300K;
//       added for Epson 300K , by Musicwind, at 2000-12-18
//                                      

interface

uses Classes, SysUtils, Windows, SyncObjs;

type

  TLPT = class
  protected
    FDeviceName: string;
    FHandle: THandle;
    FEvent: TSimpleEvent;
    FOverlap: TOverlapped;
    procedure SetActive(Value: Boolean);
    procedure SetDeviceName(AName: string);
    function  GetActive: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure WriteBuf(const Buf: PChar; Len: Integer);
    procedure Write(const AString: string);
    procedure WriteLn(const AString: string);
    procedure WriteFmt(const FmtStr: string; Args: array of const);
    property Active: Boolean read GetActive write SetActive;
    property Handle: THandle read FHandle;
  published
    property DeviceName: string read FDeviceName write SetDeviceName;
  end;

   TLPTStream = class(TStream)
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure WriteLn(const S: string);
  end;

  TEpson300K = class ( TLpt )
  private
    FiPageHeight: integer; // 一页的高度( 单位：英寸 )
    FblChinese: Boolean;   // 汉字打印模式
    FblExpress: Boolean;   // 高速打印模式
    procedure SetFiPageHeight(const Value: integer); // 页长度, 单位( 英寸 )

  public
    constructor Create; override;

    procedure BeginDoc;  // 开始一个文档
    procedure EndDoc;    // 结束....
    procedure BeginPage; // 开始页
    procedure EndPage;   // 结束页
    procedure BeginBold; // 开始粗体
    procedure EndBold;   // 结束粗体

    procedure MovePaper( iHeight: integer );
    procedure DoubleHeight(bl: Boolean);
    procedure DoubleWidth(bl: Boolean);


    property PageHeight: integer read FiPageHeight write SetFiPageHeight;
    property ChineseMode: Boolean read FblChinese write FblChinese;
    property ExpressMode: Boolean read FblExpress write FblExpress;
  end;

function LPT1: TLPT;
function LPT2: TLPT;

function Epson300k1: TEpson300k;
function Epson300k2: TEpson300k;


implementation  // ===========================================================

var

  _LPT1: TLPT = nil;
  _LPT2: TLPT = nil;
  _Epson300k1: TEpson300k = nil;
  _Epson300k2: TEpson300k = nil;


{ TLPT }

constructor TLPT.Create;
begin
  FDeviceName := 'LPT1';
  FEvent := TSimpleEvent.Create;
  FOverlap.hEvent := FEvent.Handle;
end;

destructor TLPT.Destroy;
begin
  Active := False;
  inherited;
end;                  

procedure TLPT.SetActive(Value: Boolean);
begin
  if Value = Active then exit;
  if Value then begin
    FHandle := CreateFile(PChar(FDeviceName), GENERIC_WRITE,
               FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
               OPEN_EXISTING, FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED, 0);
  end
  else begin
    CloseHandle(FHandle);
    FHandle := INVALID_HANDLE_VALUE;
  end;
end;

procedure TLPT.SetDeviceName(AName: string);
begin
  Active := False;
  FDeviceName := AName;
end;

function  TLPT.GetActive: Boolean;
begin
  Result := FHandle <> INVALID_HANDLE_VALUE;
end;

procedure TLPT.Open;
begin
  Active := True;
end;

procedure TLPT.Close;
begin
  Active := False;
end;

procedure TLPT.WriteBuf(const Buf: PChar; Len: Integer);
var
  Num: Integer;
begin
  if Active = False then
     Active := True;
  if Active and (Len > 0) then
    WriteFile(FHandle, Buf^, Cardinal( Len ), Cardinal( Num ), @FOverlap);
end;

procedure TLPT.Write(const AString: string);
begin
  WriteBuf(PChar(AString), Length(AString));
end;

procedure TLPT.WriteLn(const AString: string);
const
  CRLF: array[0..1] of Char = (#13, #10);
begin

  WriteBuf(PChar(AString), Length(AString));
  WriteBuf(CRLF, 2);
end;

procedure TLPT.WriteFmt(const FmtStr: string; Args: array of const);
begin
  Write(Format(FmtStr, Args));
end;

function TLPTStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := 0;
end;

function TLPTStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := Count;
  if Count > 0 then
    LPT1.WriteBuf(PChar(@Buffer), Count);
end;

function TLPTStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result := 0;
end;

procedure TLPTStream.WriteLn(const S: string);
begin
  LPT1.WriteLn(S);
end;


//  ==========================================================================

function LPT1: TLPT;
begin
  if _LPT1 = nil then begin
    _LPT1 := TLPT.Create;
    _LPT1.DeviceName := 'LPT1';
    _LPT1.Active := True;
  end;
  Result := _LPT1;
end;

function Epson300k1: TEpson300k;
begin
   if _Epson300k1 = nil then
   begin
      _Epson300k1 := TEpson300k.Create;
      _Epson300k1.DeviceName := 'LPT1';
      _Epson300k1.Active := True;
   end;
   result := _Epson300k1;
end;

function Epson300k2: TEpson300k;
begin
   if _Epson300k2 = nil then
   begin
      _Epson300k2 := TEpson300k.Create;
      _Epson300k2.DeviceName := 'LPT2';
      _Epson300k2.Active := True;
   end;
   result := _Epson300k2;
end;


function LPT2: TLPT;
begin
  if _LPT2 = nil then begin
    _LPT2 := TLPT.Create;
    _LPT2.DeviceName := 'LPT2';
    _LPT2.Active := True;
  end;
  Result := _LPT2;
end;

//  ==========================================================================

{ TEpson300K }

procedure TEpson300K.BeginBold;
begin
   Write( #27 + 'E' );
end;

procedure TEpson300K.DoubleWidth( bl: Boolean );
begin
   if bl then
      Write( #27 + 'W' + #1 )
   else
      Write( #27 + 'W' + #0 );
end;

procedure TEpson300K.DoubleHeight( bl: Boolean );
begin
   if bl then
      Write( #27 + 'w' + #1 )
   else
      Write( #27 + 'w' + #0 );

end;

procedure TEpson300K.BeginDoc;
begin
   Active := True;
   if FblChinese then
      Write( #28 + '&' ) ; // 设定汉字打印模式
   if FblExpress then
      Write( #28 + 'x' + #1 )
   else
      Write( #28 + 'x' + #0 );
end;

procedure TEpson300K.BeginPage;
begin
   if ( FiPageHeight >= 1 ) and ( FiPageHeight <= 22 ) then
   begin
      Write( #27 + 'C' + #0 + Char( FiPageHeight ) ) ;
      Write( #27 + '$' + #0 + #0 ); // 设定绝对位置为 y=0, x=0
   end;
end;

constructor TEpson300K.Create;
begin
   inherited;
   FiPageHeight := 0;
   FblChinese := True;
   FblExpress := False;
end;

procedure TEpson300K.EndBold;
begin
   Write( #27 + 'F' );
end;

procedure TEpson300K.EndDoc;
begin
   Active := False;
end;

procedure TEpson300K.EndPage;
begin
   if FiPageHeight <> 0 then
      Write( #12 );  
end;

procedure TEpson300K.MovePaper(iHeight: integer);
begin
   Writeln( #27 + 'J' + char( iHeight mod 255 ) );
end;

procedure TEpson300K.SetFiPageHeight(const Value: integer);
begin
   FiPageHeight := Value mod 22;
end;

initialization
finalization
  if _LPT1 <> nil then _LPT1.Free;
  if _LPT2 <> nil then _LPT2.Free;

  // new added by Musicwind , at 2000-12-18 13:16 于宁海京都
  if _Epson300k1 <> nil then _Epson300k1.Free;
  if _Epson300k2 <> nil then _Epson300k2.Free;

end.

{*******************************************************}
{                                                       }
{       Musicwind Delphi Development Package            }
{                DosPrinter Unit                        }
{                                                       }
{       Copyright ( c ) 2000,2005 Musicwind             }
{                                                       }
{ History:                                              }
{                                                       }
{    Build with Delphi5, Musicwind    [2000-03-??]      }
{                                                       }
{    TDosPrinter                                        }
{                                                       }
{*******************************************************}

unit DosPrinter;

//  Note: Only Be Ok in Win98, and the printer must be in
//        lpt1, lpt2 or lpt3;
//        And Be Sure your Windows does not install the printer
//
//  User Guide:   Just add this unit into the "uses" clause, then you may
//                call LPT1.Write, LPT1.WriteLn, LTP1.WriteFmt directly to
//                make output on the printer. (LPT2 is also supported).
//
//  Limitation:   This unit does not have error checking capabilities.

//  New added Guide:
//  TDosPrinter;
//       Can Check whether the printer is empty of paper, or
//       printer does not linked, or other errors.
//

interface

uses Classes, SysUtils, Windows, MusicSys;

type
  // 并口号
  TDosLptPort = ( dpLpt1, dpLpt2, dpLpt3 );

  // 错误类别, ( 未联机, 缺纸, 超时 ) 　
  TErrType = ( etLinkLost, etLackPaper, etTimeout );

  // 打印错误事件
  TErrMsgEvent = procedure(Sender: TObject; ErrType: TErrType;
                     var Retry: Boolean ) of object;

  TDosPrinter = class
  private
     FLptPort: TDosLptPort;
     FOnErr: TErrMsgEvent;
     FblActive: Boolean;
  protected

  public
     Constructor Create;

     procedure BeginDoc;
     procedure EndDoc;
     procedure DoDoubleWidth( bl: Boolean );
     procedure DoDoubleHeight( bl: Boolean );
     procedure DoBold( bl: Boolean );
     procedure ChineseMode;
     procedure DoExpress( bl: Boolean );
     procedure CR;
     procedure Writeln( sLine: string );
     procedure Write( sLine: string );
     function WriteChar( Achar: char ): Boolean;
     procedure MovePaper( iSize: integer );

     property Active: Boolean read FblActive;
     property LptPort: TDosLptPort read FLptPort write FLptPort;
     property OnErr: TErrMsgEvent read FOnErr write FOnErr;

  end;

function DosLpt1: TDosPrinter;
function DosLpt2: TDosPrinter;
  
implementation

var
   _DosLpt1: TDosPrinter = nil;
   _DosLpt2: TDosPrinter = nil;

function DosLpt1: TDosPrinter;
begin
   if not Assigned( _DosLpt1 ) then
   begin
      _DosLpt1 := TDosPrinter.Create;
      _DosLpt1.LptPort := dpLpt1;
   end;
   result := _DosLpt1;
end;

function DosLpt2: TDosPrinter;
begin
   if not Assigned( _DosLpt2 ) then
   begin
      _DosLpt2 := TDosPrinter.Create;
      _DosLpt2.LptPort := dpLpt2;
   end;
   result := _DosLpt2;
end;

{ TDosPrinter }

procedure TDosPrinter.BeginDoc;
begin
   // Do nothing ...
end;

procedure TDosPrinter.ChineseMode;
begin
   Write( #28 + '&' );
end;

procedure TDosPrinter.CR;
begin
   Write( #13 );
end;

constructor TDosPrinter.Create;
begin
   FLptPort := dpLpt1;
   FblActive := True;
end;

procedure TDosPrinter.DoBold(bl: Boolean);
begin
   if bl then
      Write( #27 + 'E' )
   else
      Write( #27 + 'F' );
end;

procedure TDosPrinter.DoDoubleHeight(bl: Boolean);
begin
   if bl then
      Write( #27 + 'w' + #1 )
   else
      Write( #27 + 'w' + #0 );
end;

procedure TDosPrinter.DoDoubleWidth(bl: Boolean);
begin
   if bl then
      Write( #27 + 'W' + #1 )
   else
      Write( #27 + 'W' + #0 );
end;

procedure TDosPrinter.DoExpress(bl: Boolean);
begin
   if bl then
      Write( #28 + 'x' + #1 )
   else
      Write( #28 + 'x' + #0 );
end;

procedure TDosPrinter.EndDoc;
begin
   // Do nothing ... 
end;

procedure TDosPrinter.MovePaper(iSize: integer);
begin
   Write( #27 + 'J' + char( iSize mod 255 ) );
end;

procedure TDosPrinter.Write(sLine: string);
var
  index: longint;
begin
  for Index := 1 to length( sLine ) do
     if not WriteChar( sLine[Index]  ) then
        Break;
end;

function TDosPrinter.WriteChar( AChar: char): Boolean;
var
   byteChar, byteStatus: Byte;
   wordLpt: Word;
   bPaperOut, bSelected, bIOError, bTimeOut, bOK: Boolean;
   // below is new added by Musicwind, 2001-02-08
   FErrType: TErrType;
   Retry: Boolean;
   dwTimeOut: DWORD;
begin
   result := False;

   if not mscIsWin98 then
   begin
      FblActive := result;
      Exit;
   end;

   byteChar := byte( AChar );
   if FLptPort = dpLpt1 then
      wordLpt := 0 else
   if FLptPort = dpLpt2 then
      wordLpt := 1 else
   if FLptPort = dpLpt3 then
      wordLpt := 2
   else
      wordLpt := 0;
   repeat
      retry := False;

      byteStatus := $40;
      while (( byteStatus and $80 ) = 0 ) and (( byteStatus and $40 ) <> 0 ) do
      asm
         MOV AH, 0
         MOV DX, wordLpt
         MOV AL, byteChar
         INT 17H
         MOV byteStatus, AH
      end;
         
      bTimeOut := ( byteStatus and $01 ) <> 0;
      bIOError := ( byteStatus and $08 ) <> 0;
      bSelected := ( byteStatus and $10 ) <> 0;
      bPaperOut := ( byteStatus and $20 ) <> 0;

      if bTimeOut then
         FErrType := etTimeOut
      else
      if bSelected and bPaperOut and bIOError then
         FErrType := etLackPaper
      else
      if bSelected and bPaperOut or bIOError then
         FErrType := etLinkLost
      else
      begin
         // Print content
         result := True;

      end;

      if not result then
      begin
         Retry := False;
         if Assigned( FOnErr ) then
         begin
            Retry := True;
            FOnErr( Self, FErrType, Retry );
         end;
      end;
   until result or not Retry;
   FblActive := result;
   if not FblActive then
      raise Exception.Create( '打印出错!' );
end;

procedure TDosPrinter.Writeln(sLine: string);
begin
   Write( sLine + #13#10 );
end;

initialization

finalization

end.



{*******************************************************}
{                                                       }
{       Musicwind Delphi Development Package            }
{                    Lpt Unit                           }
{                                                       }
{       Copyright ( c ) 2000,2005 Musicwind             }
{                                                       }
{ History:                                              }
{                                                       }
{    Build with Delphi5, Musicwind    [2000-12-18]      }
{                                                       }
{    TLpt
{    TLptStream
{    TEpson300K
{                                                       }
{*******************************************************}
unit LPT;

//  Note: Only Be Ok in WinNt or later OS
//        And Be Sure your Windows does not install the printer
//
//  User Guide:   Just add this unit into the "uses" clause, then you may
//                call LPT1.Write, LPT1.WriteLn, LTP1.WriteFmt directly to
//                make output on the printer. (LPT2 is also supported).
//
//  Limitation:   This unit does not have error checking capabilities.

//  New added Guide:
//  TEpson300K;
//       added for Epson 300K , by Musicwind, at 2000-12-18
//                                      

interface

uses Classes, SysUtils, Windows, SyncObjs;

type

  TLPT = class
  protected
    FDeviceName: string;
    FHandle: THandle;
    FEvent: TSimpleEvent;
    FOverlap: TOverlapped;
    procedure SetActive(Value: Boolean);
    procedure SetDeviceName(AName: string);
    function  GetActive: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure WriteBuf(const Buf: PChar; Len: Integer);
    procedure Write(const AString: string);
    procedure WriteLn(const AString: string);
    procedure WriteFmt(const FmtStr: string; Args: array of const);
    property Active: Boolean read GetActive write SetActive;
    property Handle: THandle read FHandle;
  published
    property DeviceName: string read FDeviceName write SetDeviceName;
  end;

   TLPTStream = class(TStream)
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure WriteLn(const S: string);
  end;

  TEpson300K = class ( TLpt )
  private
    FiPageHeight: integer; // 一页的高度( 单位：英寸 )
    FblChinese: Boolean;   // 汉字打印模式
    FblExpress: Boolean;   // 高速打印模式
    procedure SetFiPageHeight(const Value: integer); // 页长度, 单位( 英寸 )

  public
    constructor Create; override;

    procedure BeginDoc;  // 开始一个文档
    procedure EndDoc;    // 结束....
    procedure BeginPage; // 开始页
    procedure EndPage;   // 结束页
    procedure BeginBold; // 开始粗体
    procedure EndBold;   // 结束粗体

    procedure MovePaper( iHeight: integer );
    procedure DoubleHeight(bl: Boolean);
    procedure DoubleWidth(bl: Boolean);


    property PageHeight: integer read FiPageHeight write SetFiPageHeight;
    property ChineseMode: Boolean read FblChinese write FblChinese;
    property ExpressMode: Boolean read FblExpress write FblExpress;
  end;

function LPT1: TLPT;
function LPT2: TLPT;

function Epson300k1: TEpson300k;
function Epson300k2: TEpson300k;


implementation  // ===========================================================

var

  _LPT1: TLPT = nil;
  _LPT2: TLPT = nil;
  _Epson300k1: TEpson300k = nil;
  _Epson300k2: TEpson300k = nil;


{ TLPT }

constructor TLPT.Create;
begin
  FDeviceName := 'LPT1';
  FEvent := TSimpleEvent.Create;
  FOverlap.hEvent := FEvent.Handle;
end;

destructor TLPT.Destroy;
begin
  Active := False;
  inherited;
end;                  

procedure TLPT.SetActive(Value: Boolean);
begin
  if Value = Active then exit;
  if Value then begin
    FHandle := CreateFile(PChar(FDeviceName), GENERIC_WRITE,
               FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
               OPEN_EXISTING, FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED, 0);
  end
  else begin
    CloseHandle(FHandle);
    FHandle := INVALID_HANDLE_VALUE;
  end;
end;

procedure TLPT.SetDeviceName(AName: string);
begin
  Active := False;
  FDeviceName := AName;
end;

function  TLPT.GetActive: Boolean;
begin
  Result := FHandle <> INVALID_HANDLE_VALUE;
end;

procedure TLPT.Open;
begin
  Active := True;
end;

procedure TLPT.Close;
begin
  Active := False;
end;

procedure TLPT.WriteBuf(const Buf: PChar; Len: Integer);
var
  Num: Integer;
begin
  if Active = False then
     Active := True;
  if Active and (Len > 0) then
    WriteFile(FHandle, Buf^, Cardinal( Len ), Cardinal( Num ), @FOverlap);
end;

procedure TLPT.Write(const AString: string);
begin
  WriteBuf(PChar(AString), Length(AString));
end;

procedure TLPT.WriteLn(const AString: string);
const
  CRLF: array[0..1] of Char = (#13, #10);
begin

  WriteBuf(PChar(AString), Length(AString));
  WriteBuf(CRLF, 2);
end;

procedure TLPT.WriteFmt(const FmtStr: string; Args: array of const);
begin
  Write(Format(FmtStr, Args));
end;

function TLPTStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := 0;
end;

function TLPTStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := Count;
  if Count > 0 then
    LPT1.WriteBuf(PChar(@Buffer), Count);
end;

function TLPTStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result := 0;
end;

procedure TLPTStream.WriteLn(const S: string);
begin
  LPT1.WriteLn(S);
end;


//  ==========================================================================

function LPT1: TLPT;
begin
  if _LPT1 = nil then begin
    _LPT1 := TLPT.Create;
    _LPT1.DeviceName := 'LPT1';
    _LPT1.Active := True;
  end;
  Result := _LPT1;
end;

function Epson300k1: TEpson300k;
begin
   if _Epson300k1 = nil then
   begin
      _Epson300k1 := TEpson300k.Create;
      _Epson300k1.DeviceName := 'LPT1';
      _Epson300k1.Active := True;
   end;
   result := _Epson300k1;
end;

function Epson300k2: TEpson300k;
begin
   if _Epson300k2 = nil then
   begin
      _Epson300k2 := TEpson300k.Create;
      _Epson300k2.DeviceName := 'LPT2';
      _Epson300k2.Active := True;
   end;
   result := _Epson300k2;
end;


function LPT2: TLPT;
begin
  if _LPT2 = nil then begin
    _LPT2 := TLPT.Create;
    _LPT2.DeviceName := 'LPT2';
    _LPT2.Active := True;
  end;
  Result := _LPT2;
end;

//  ==========================================================================

{ TEpson300K }

procedure TEpson300K.BeginBold;
begin
   Write( #27 + 'E' );
end;

procedure TEpson300K.DoubleWidth( bl: Boolean );
begin
   if bl then
      Write( #27 + 'W' + #1 )
   else
      Write( #27 + 'W' + #0 );
end;

procedure TEpson300K.DoubleHeight( bl: Boolean );
begin
   if bl then
      Write( #27 + 'w' + #1 )
   else
      Write( #27 + 'w' + #0 );

end;

procedure TEpson300K.BeginDoc;
begin
   Active := True;
   if FblChinese then
      Write( #28 + '&' ) ; // 设定汉字打印模式
   if FblExpress then
      Write( #28 + 'x' + #1 )
   else
      Write( #28 + 'x' + #0 );
end;

procedure TEpson300K.BeginPage;
begin
   if ( FiPageHeight >= 1 ) and ( FiPageHeight <= 22 ) then
   begin
      Write( #27 + 'C' + #0 + Char( FiPageHeight ) ) ;
      Write( #27 + '$' + #0 + #0 ); // 设定绝对位置为 y=0, x=0
   end;
end;

constructor TEpson300K.Create;
begin
   inherited;
   FiPageHeight := 0;
   FblChinese := True;
   FblExpress := False;
end;

procedure TEpson300K.EndBold;
begin
   Write( #27 + 'F' );
end;

procedure TEpson300K.EndDoc;
begin
   Active := False;
end;

procedure TEpson300K.EndPage;
begin
   if FiPageHeight <> 0 then
      Write( #12 );  
end;

procedure TEpson300K.MovePaper(iHeight: integer);
begin
   Writeln( #27 + 'J' + char( iHeight mod 255 ) );
end;

procedure TEpson300K.SetFiPageHeight(const Value: integer);
begin
   FiPageHeight := Value mod 22;
end;

initialization
finalization
  if _LPT1 <> nil then _LPT1.Free;
  if _LPT2 <> nil then _LPT2.Free;

  // new added by Musicwind , at 2000-12-18 13:16 于宁海京都
  if _Epson300k1 <> nil then _Epson300k1.Free;
  if _Epson300k2 <> nil then _Epson300k2.Free;

end.