frxdmpexport.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Dot-matrix export filter }
{ }
{ Copyright (c) 1998-2005 }
{ by Fast Reports Inc. }
{ }
{******************************************}

unit frxDMPExport;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, frxClass, Buttons, ComCtrls, frxDMPClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};

type
  TfrxDotMatrixExport = class(TfrxCustomExportFilter)
  private
    FBufWidth:Integer;
    FBufHeight:Integer;
    FCharBuf:array of Char;
    FCopies:Integer;
    FCustomFrameSet:String;
    FEscModel:Integer;
    FFileName:String;
    FFrameBuf:array of Byte;
    FGraphicFrames:Boolean;
    FMaxHeight:Integer;
    FOEMConvert:Boolean;
    FPageBreaks:Boolean;
    FPageStyle:Integer;
    FPrinterInitString:String;
    FSaveToFile:Boolean;
    FStream:TStream;
    FStyleBuf:array of Integer;
    FUseIniSettings:Boolean;

    function GetTempFName:String;
    function IntToStyle(i:Integer):TfrxDMPFontStyles;
    function StyleChange(OldStyle, NewStyle:Integer):String;
    function StyleOff(Style:Integer):String;
    function StyleOn(Style:Integer):String;
    function StyleToInt(Style:TfrxDMPFontStyles):Integer;

    procedure CreateBuf(Width, Height:Integer);
    procedure DrawFrame(x, y, dx, dy:Integer; Style:Integer);
    procedure DrawMemo(x, y, dx, dy:Integer; Memo:TfrxDMPMemoView);
    procedure FlushBuf;
    procedure FormFeed;
    procedure FreeBuf;
    procedure Landscape;
    procedure Portrait;
    procedure Reset;
    procedure SetFrame(x, y:Integer; typ:Byte);
    procedure SetString(x, y:Integer; const s:String);
    procedure SetStyle(x, y, Style:Integer);
    procedure SpoolFile(const FileName:String);
    procedure WriteStrLn(const str:String);
    procedure WriteStr(const str:String);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function ShowModal:TModalResult; override;
    function Start:Boolean; override;
    procedure ExportObject(Obj:TfrxComponent); override;
    procedure Finish; override;
    procedure FinishPage(Page:TfrxReportPage; Index:Integer); override;
    procedure StartPage(Page:TfrxReportPage; Index:Integer); override;
  published
    property CustomFrameSet:String read FCustomFrameSet write FCustomFrameSet;
    property EscModel:Integer read FEscModel write FEscModel;
    property FileName:String read FFileName write FFileName;
    property GraphicFrames:Boolean read FGraphicFrames write FGraphicFrames;
    property InitString:String read FPrinterInitString write FPrinterInitString;
    property OEMConvert:Boolean read FOEMConvert write FOEMConvert default True;
    property PageBreaks:Boolean read FPageBreaks write FPageBreaks default True;
    property SaveToFile:Boolean read FSaveToFile write FSaveToFile;
    property UseIniSettings:Boolean read FUseIniSettings write FUseIniSettings;
  end;

  TfrxDMPExportDialog = class(TForm)
    OK:TButton;
    Cancel:TButton;
    SaveDialog1:TSaveDialog;
    PrinterL:TLabel;
    Bevel2:TBevel;
    PagesL:TLabel;
    Bevel1:TBevel;
    CopiesL:TLabel;
    Bevel3:TBevel;
    Bevel4:TBevel;
    Image1:TImage;
    PrinterCB:TComboBox;
    SaveToFileCB:TCheckBox;
    EscCB:TComboBox;
    CopiesNL:TLabel;
    CopiesE:TEdit;
    CopiesUD:TUpDown;
    AllRB:TRadioButton;
    CurPageRB:TRadioButton;
    PageNumbersRB:TRadioButton;
    DescrL:TLabel;
    RangeE:TEdit;
    Bevel5:TBevel;
    OptionsL:TLabel;
    PageBreaksCB:TCheckBox;
    OemCB:TCheckBox;
    PseudoCB:TCheckBox;
    EscL:TLabel;
    Bevel6:TBevel;
    procedure FormCreate(Sender:TObject);
    procedure PrinterCBDrawItem(Control:TWinControl; Index:Integer;
      ARect:TRect; State:TOwnerDrawState);
    procedure PrinterCBClick(Sender:TObject);
    procedure FormHide(Sender:TObject);
    procedure RangeEEnter(Sender:TObject);
  private
    OldIndex:Integer;
  end;

implementation

uses frxUtils, frxPrinter, frxXML, Printers, frxRes, IniFiles, Winspool;

{$R *.dfm}

const
  cmdName = 1;
  cmdReset = 2;
  cmdFormFeed = 3;
  cmdLandscape = 4;
  cmdPortrait = 5;
  cmdBoldOn = 6;
  cmdBoldOff = 7;
  cmdItalicOn = 8;
  cmdItalicOff = 9;
  cmdUnderlineOn = 10;
  cmdUnderlineOff = 11;
  cmdSuperscriptOn = 12;
  cmdSuperscriptOff = 13;
  cmdSubscriptOn = 14;
  cmdSubscriptOff = 15;
  cmdCondensedOn = 16;
  cmdCondensedOff = 17;
  cmdWideOn = 18;
  cmdWideOff = 19;
  cmd12cpiOn = 20;
  cmd12cpiOff = 21;
  cmd15cpiOn = 22;
  cmd15cpiOff = 23;

  CommandCount = 23;
  CommandNames:array[1..CommandCount] of String = (
    'Name', 'Reset', 'FormFeed', 'Landscape', 'Portrait',
    'BoldOn', 'BoldOff', 'ItalicOn', 'ItalicOff', 'UnderlineOn', 'UnderlineOff',
    'SuperscriptOn', 'SuperscriptOff', 'SubscriptOn', 'SubscriptOff',
    'CondensedOn', 'CondensedOff', 'WideOn', 'WideOff',
    'cpi12On', 'cpi12Off', 'cpi15On', 'cpi15Off');

  FrameSet:array[1..2] of String = (
    '+|+++-+++++',
    #32#32#192#32#179#218#195#32#217#196#193#191#180#194#197);
  DefaultPrinters:String =
'<?xml version="1.0" encoding="utf-8"?>'+
'<printers>'+
' <printer id="0" Name="None" FormFeed="0C"/>'+
' <printer id="1" Name="Epson Generic" Inherit="0" Reset="1B40" '+
'BoldOn="1B45" BoldOff="1B46" ItalicOn="1B34" ItalicOff="1B35" '+
'UnderlineOn="1B2D01" UnderlineOff="1B2D00" SuperscriptOn="#27#83#01" SuperscriptOff="#27#84" '+
'SubscriptOn="#27#83#00" SubscriptOff="#27#84" CondensedOn="0F" CondensedOff="12" '+
'WideOn="1B5701" WideOff="1B5700" cpi12On="1B4D" cpi12Off="1B50" cpi15On="1B67" cpi15Off="1B50"/>'+
' <printer id="2" Name="HP Generic" Inherit="0" Reset="1B45" '+
'Portrait="1B266C304F" Landscape="1B266C314F" BoldOn="1B28733342" '+
'BoldOff="1B28733042" ItalicOn="1B28733153" ItalicOff="1B28733053" '+
'UnderlineOn="1B26643144" UnderlineOff="1B266440" '+
'SuperscriptOn="#27#38#97#45#46#53#82" SuperscriptOff="#27#38#97#43#46#53#82" '+
'SubscriptOn="#27#38#97#43#46#53#82" SubscriptOff="#27#38#97#45#46#53#82" '+
'CondensedOn="1B2873313648" CondensedOff="1B2873313048" '+
'WideOn="1B28733548" WideOff="1B2873313048" cpi12On="1B266B313048" '+
'cpi12Off="1B266B313248" cpi15On="" cpi15Off=""/>'+
' <printer id="3" Name="IBM Generic" Inherit="1" Reset="" cpi12On="1B3A" '+
'cpi12Off="12" cpi15On="1B67" cpi15Off="12"/>'+
'</printers>';

type
  TfrxDMPrinter = class(TCollectionItem)
  public
    Commands:array[1..CommandCount] of String;
    procedure Assign(Source:TPersistent); override;
  end;

  TfrxDMPrinters = class(TCollection)
  private
    function GetItem(Index:Integer):TfrxDMPrinter;
  public
    constructor Create;
    function Add:TfrxDMPrinter;
    procedure ReadDefaultPrinters;
    procedure ReadExtPrinters;
    procedure ReadPrinters(x:TfrxXMLDocument);
    property Items[Index:Integer]:TfrxDMPrinter read GetItem; default;
  end;

  TWordSet = set of 0..15;
  PWordSet = ^TWordSet;
  PfrxDMPFontStyles = ^TfrxDMPFontStyles;

var
  frxDMPrinters:TfrxDMPrinters;

{ TfrxDMPrinter }

procedure TfrxDMPrinter.Assign(Source:TPersistent);
begin
  if Source is TfrxDMPrinter then
    Commands:= TfrxDMPrinter(Source).Commands;
end;

{ TfrxDMPrinters }

constructor TfrxDMPrinters.Create;
begin
  inherited Create(TfrxDMPrinter);
end;

function TfrxDMPrinters.Add:TfrxDMPrinter;
begin
  Result:= TfrxDMPrinter(inherited Add);
end;

function TfrxDMPrinters.GetItem(Index:Integer):TfrxDMPrinter;
begin
  Result:= TfrxDMPrinter(inherited Items[Index]);
end;

procedure TfrxDMPrinters.ReadDefaultPrinters;
var
  x:TfrxXMLDocument;
  s:TStringStream;
begin
  x:= TfrxXMLDocument.Create;
  s:= TStringStream.Create(DefaultPrinters);
  try
    x.LoadFromStream(s);
    ReadPrinters(x);
  finally
    s.Free;
    x.Free;
  end;
end;

procedure TfrxDMPrinters.ReadExtPrinters;
var
  x:TfrxXMLDocument;
begin
  if not FileExists(ExtractFilePath(Application.ExeName)+'printers.xml') then
    Exit;
  x:= TfrxXMLDocument.Create;
  try
    x.LoadFromFile(ExtractFilePath(Application.ExeName)+'printers.xml');
    ReadPrinters(x);
  except
    ShowMessage('Error in file printers.xml');
  end;

  x.Free;
end;

procedure TfrxDMPrinters.ReadPrinters(x:TfrxXMLDocument);
var
  i, j:Integer;
  xi:TfrxXMLItem;
  Item:TfrxDMPrinter;

  function ConvertProp(s:String):String;
  var
    i:Integer;
    s1:String;
  begin
    Result:= '';
    s1:= '';
    if Pos('#', s) = 1 then
    begin
      s:= s+'#';
      for i:= 2 to Length(s) do
        if s[i] = '#' then
        begin
          Result:= Result+Chr(StrToInt(s1));
          s1:= '';
        end
        else
          s1:= s1+s[i];
    end
    else
    begin
      for i:= 1 to Length(s) do
      begin
        s1:= s1+s[i];
        if i mod 2 = 0 then
        begin
          Result:= Result+Chr(StrToInt('$'+s1));
          s1:= '';
        end;
      end;
    end;
  end;

begin
  Clear;
  for i:= 0 to x.Root.Count-1 do
  begin
    Item:= Add;
    xi:= x.Root[i];
    if xi.Prop['Inherit']<>'' then
      Item.Assign(Items[StrToInt(xi.Prop['Inherit'])]);
    for j:= 1 to CommandCount do
      if xi.PropExists(CommandNames[j]) then
        if j = 1 then
          Item.Commands[j]:= xi.Prop[CommandNames[j]] else
          Item.Commands[j]:= ConvertProp(xi.Prop[CommandNames[j]]);
  end;
end;

{ TfrxDotMatrixExport }

constructor TfrxDotMatrixExport.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  frxDotMatrixExport:= Self;
  FCopies:= 1;
  FOEMConvert:= True;
  FPageBreaks:= True;
  FUseIniSettings:= True;
end;

destructor TfrxDotMatrixExport.Destroy;
begin
  FreeBuf;
  frxDotMatrixExport:= nil;
  inherited;
end;

function TfrxDotMatrixExport.GetTempFName:String;
var
  Path:String[64];
  FileName:String[255];
begin
  Path:= Report.EngineOptions.TempDir;
  if Path = '' then
    Path[0]:= Chr(GetTempPath(64, @Path[1])) else
    Path:= Path+#0;
  if (Path<>'') and (Path[Length(Path)]<>'\') then
    Path:= Path+'\';

  GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
  Result:= StrPas(@FileName[1]);
end;

function TfrxDotMatrixExport.IntToStyle(i:Integer):TfrxDMPFontStyles;
begin
  Result:= TfrxDMPFontStyles(PfrxDMPFontStyles(@i)^);
end;

function TfrxDotMatrixExport.StyleToInt(Style:TfrxDMPFontStyles):Integer;
begin
  Result:= Word(PWordSet(@Style)^);
end;

procedure TfrxDotMatrixExport.SpoolFile(const FileName:String);
const
  BUF_SIZE = 1024;
var
  f:TFileStream;
  buf:String;
  l:longint;
begin
  if Report.ReportOptions.Name<>'' then
    frxPrinters.Printer.Title:= Report.ReportOptions.Name else
    frxPrinters.Printer.Title:= Report.FileName;
  frxPrinters.Printer.BeginRAWDoc;

  f:= TFileStream.Create(FileName, fmOpenRead);
  SetLength(buf, BUF_SIZE);
  l:= BUF_SIZE;
  while l = BUF_SIZE do
  begin
    l:= f.Read(buf[1], BUF_SIZE);
    SetLength(buf, l);
    frxPrinters.Printer.WriteRAWDoc(buf);
  end;

  f.Free;
  frxPrinters.Printer.EndRAWDoc;
end;

procedure TfrxDotMatrixExport.FormFeed;
begin
  WriteStr(frxDMPrinters[FEscModel].Commands[cmdFormFeed]);
end;

procedure TfrxDotMatrixExport.Landscape;
begin
  WriteStr(frxDMPrinters[FEscModel].Commands[cmdLandscape]);
end;

procedure TfrxDotMatrixExport.Portrait;
begin
  WriteStr(frxDMPrinters[FEscModel].Commands[cmdPortrait]);
end;

procedure TfrxDotMatrixExport.Reset;
begin
  WriteStr(frxDMPrinters[FEscModel].Commands[cmdReset]);
end;

function TfrxDotMatrixExport.StyleOff(Style:Integer):String;
var
  st:TfrxDMPFontStyles;
begin
  st:= IntToStyle(Style);
  Result:= '';
  if fsxBold in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdBoldOff];
  if fsxItalic in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdItalicOff];
  if fsxUnderline in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdUnderlineOff];
  if fsxSuperScript in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdSuperscriptOff];
  if fsxSubScript in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdSubscriptOff];
  if fsxCondensed in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdCondensedOff];
  if fsxWide in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdWideOff];
  if fsx12cpi in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmd12cpiOff];
  if fsx15cpi in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmd15cpiOff];
end;

function TfrxDotMatrixExport.StyleOn(Style:Integer):String;
var
  st:TfrxDMPFontStyles;
begin
  st:= IntToStyle(Style);
  Result:= '';
  if fsxBold in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdBoldOn];
  if fsxItalic in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdItalicOn];
  if fsxUnderline in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdUnderlineOn];
  if fsxSuperScript in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdSuperscriptOn];
  if fsxSubScript in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdSubscriptOn];
  if fsxCondensed in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdCondensedOn];
  if fsxWide in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmdWideOn];
  if fsx12cpi in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmd12cpiOn];
  if fsx15cpi in st then
    Result:= Result+frxDMPrinters[FEscModel].Commands[cmd15cpiOn];
end;

function TfrxDotMatrixExport.StyleChange(OldStyle, NewStyle:Integer):String;
begin
  Result:= StyleOff(OldStyle)+StyleOn(NewStyle);
end;

procedure TfrxDotMatrixExport.SetFrame(x, y:Integer; typ:Byte);