frxexportodf.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{        Open Document Format export       }
{                                          }
{         Copyright (c) 1998-2008          }
{          by Alexander Fediachov,         }
{             Fast Reports Inc.            }
{                                          }
{******************************************}

unit frxExportODF;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, extctrls, Printers, frxClass, frxExportMatrix, frxProgress,
  frxXML, ShellAPI,  frxZip {$IFDEF Delphi6}, Variants {$ENDIF};

type
  TfrxODFExportDialog = class(TForm)
    OkB: TButton;
    CancelB: TButton;
    SaveDialog1: TSaveDialog;
    GroupPageRange: TGroupBox;
    DescrL: TLabel;
    AllRB: TRadioButton;
    CurPageRB: TRadioButton;
    PageNumbersRB: TRadioButton;
    PageNumbersE: TEdit;
    GroupQuality: TGroupBox;
    WCB: TCheckBox;
    ContinuousCB: TCheckBox;
    PageBreaksCB: TCheckBox;
    OpenCB: TCheckBox;
    BackgrCB: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure PageNumbersEChange(Sender: TObject);
    procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  end;

  TfrxODFExport = class(TfrxCustomExportFilter)
  private
    FExportPageBreaks: Boolean;
    FExportStyles: Boolean;
    FFirstPage: Boolean;
    FMatrix: TfrxIEMatrix;
    FOpenAfterExport: Boolean;
    FPageBottom: Extended;
    FPageLeft: Extended;
    FPageRight: Extended;
    FPageTop: Extended;
    FPageWidth: Extended;
    FPageHeight: Extended;
    FPageOrientation: TPrinterOrientation;
    FShowProgress: Boolean;
    FWysiwyg: Boolean;
    FBackground: Boolean;
    FCreator: String;
    FEmptyLines: Boolean;
    FTempFolder: String;
    FZipFile: TfrxZipArchive;
    FThumbImage: TImage;
    FProgress: TfrxProgress;
    FExportType: String;
    FExportEMF: Boolean;
    procedure DoOnProgress(Sender: TObject);
    function OdfPrepareString(const Str: WideString): WideString;
    function OdfGetFrameName(const FrameStyle:  TfrxFrameStyle): String;
    procedure OdfMakeHeader(const Item: TfrxXMLItem);
    procedure OdfCreateMeta(const FileName: String; const Creator: String);
    procedure OdfCreateManifest(const FileName: String; const PicCount: Integer; const MValue: String);
    procedure OdfCreateMime(const FileName: String; const MValue: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    function ShowModal: TModalResult; override;
    function Start: Boolean; override;
    procedure Finish; override;
    procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
    procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
    procedure ExportObject(Obj: TfrxComponent); override;
    property ExportType: String read FExportType write FExportType;
    property ExportTitle;
  protected
    procedure ExportPage(Stream: TStream);
  published
    property ExportEMF: Boolean read FExportEMF write FExportEMF;
    property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
    property ExportPageBreaks: Boolean read FExportPageBreaks write FExportPageBreaks default True;
    property OpenAfterExport: Boolean read FOpenAfterExport
      write FOpenAfterExport default False;
    property ShowProgress: Boolean read FShowProgress write FShowProgress;
    property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
    property Background: Boolean read FBackground write FBackground default False;
    property Creator: String read FCreator write FCreator;
    property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
    property SuppressPageHeadersFooters;
    property OverwritePrompt;
  end;

  TfrxODSExport = class(TfrxODFExport)
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    property ExportTitle;
  published
    property ExportStyles;
    property ExportPageBreaks;
    property OpenAfterExport;
    property ShowProgress;
    property Wysiwyg;
    property Background;
    property Creator;
    property EmptyLines;
    property SuppressPageHeadersFooters;
    property OverwritePrompt;
  end;

  TfrxODTExport = class(TfrxODFExport)
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
  published
    property ExportStyles;
    property ExportPageBreaks;
    property OpenAfterExport;
    property ShowProgress;
    property Wysiwyg;
    property Background;
    property Creator;
    property EmptyLines;
    property SuppressPageHeadersFooters;
    property OverwritePrompt;
  end;

implementation

uses frxUtils, frxFileUtils, frxUnicodeUtils, frxRes, frxrcExports;

{$R *.dfm}

const
  odfDivider = 37.82;
  odfPageDiv = 37.8;
  odfMargDiv = 10;
  odfHeaderSize = 20;
  odfRep = 'urn:oasis:names:tc:opendocument:xmlns:';

var
  odfXMLHeader: array[0..odfHeaderSize - 1] of array [0..1] of String = (
  ('xmlns:office', odfRep + 'office:1.0'),
  ('xmlns:style', odfRep + 'style:1.0'),
  ('xmlns:text', odfRep + 'text:1.0'),
  ('xmlns:table', odfRep + 'table:1.0'),
  ('xmlns:draw', odfRep + 'drawing:1.0'),
  ('xmlns:fo', odfRep + 'xsl-fo-compatible:1.0'),
  ('xmlns:xlink', 'http://www.w3.org/1999/xlink'),
  ('xmlns:dc', 'http://purl.org/dc/elements/1.1/'),
  ('xmlns:meta', odfRep + 'meta:1.0'),
  ('xmlns:number', odfRep + 'datastyle:1.0'),
  ('xmlns:svg', odfRep + 'svg-compatible:1.0'),
  ('xmlns:chart', odfRep + 'chart:1.0'),
  ('xmlns:dr3d', odfRep + 'dr3d:1.0'),
  ('xmlns:math', 'http://www.w3.org/1998/Math/MathML'),
  ('xmlns:form', odfRep + 'form:1.0'),
  ('xmlns:script', odfRep + 'script:1.0'),
  ('xmlns:dom', 'http://www.w3.org/2001/xml-events'),
  ('xmlns:xforms', 'http://www.w3.org/2002/xforms'),
  ('xmlns:xsd', 'http://www.w3.org/2001/XMLSchema'),
  ('xmlns:xsi', 'http://www.w3.org/2001/XMLSchema-instance'));

{ TfrxODFExport }

constructor TfrxODFExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FExportPageBreaks := True;
  FExportStyles := True;
  FShowProgress := True;
  FWysiwyg := True;
  FBackground := True;
  FCreator := 'FastReport';
  FEmptyLines := True;
  FThumbImage := TImage.Create(nil);
  FExportEMF := True;
end;

class function TfrxODFExport.GetDescription: String;
begin
  Result := '';
end;

procedure TfrxODFExport.OdfCreateMeta(const FileName: String; const Creator: String);
var
  XML: TfrxXMLDocument;
begin
  XML := TfrxXMLDocument.Create;
  try
    XML.AutoIndent := True;
    XML.Root.Name := 'office:document-meta';
    XML.Root.Prop['xmlns:office'] := 'urn:oasis:names:tc:opendocument:xmlns:office:1.0';
    XML.Root.Prop['xmlns:xlink'] := 'http://www.w3.org/1999/xlink';
    XML.Root.Prop['xmlns:dc'] := 'http://purl.org/dc/elements/1.1/';
    XML.Root.Prop['xmlns:meta'] := 'urn:oasis:names:tc:opendocument:xmlns:meta:1.0';
    with XML.Root.Add do
    begin
      Name := 'office:meta';
      with Add do
      begin
        Name := 'meta:generator';
        Value := 'fast-report.com/Fast Report/build:' + FR_VERSION;
      end;
      with Add do
      begin
        Name := 'meta:initial-creator';
        Value := Creator;
      end;
      with Add do
      begin
        Name := 'meta:creation-date';
        Value := FormatDateTime('YYYY-MM-DD', Now) + 'T' + FormatDateTime('HH:MM:SS', Now);
      end;
    end;
    XML.SaveToFile(FileName);
  finally
    XML.Free;
  end;
end;

procedure TfrxODFExport.OdfCreateMime(const FileName: String; const MValue: String);
var
  f: TFileStream;
  s: String;
begin
  f := TFileStream.Create(FileName, fmCreate);
  try
    s := 'application/vnd.oasis.opendocument.' + MValue;
    f.Write(s[1], Length(s));
  finally
    f.Free;
  end;
end;

procedure TfrxODFExport.OdfCreateManifest(const FileName: String; const PicCount: Integer; const MValue: String);
var
  XML: TfrxXMLDocument;
  i: Integer;
  Fmime, s: String;
begin
  XML := TfrxXMLDocument.Create;
  try
    XML.AutoIndent := True;
    XML.Root.Name := 'manifest:manifest';
    XML.Root.Prop['xmlns:manifest'] := 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0';
    with XML.Root.Add do
    begin
      Name := 'manifest:file-entry';
      Prop['manifest:media-type'] := 'application/vnd.oasis.opendocument.' + MValue;
      Prop['manifest:full-path'] := '/';
    end;
    with XML.Root.Add do
    begin
      Name := 'manifest:file-entry';
      Prop['manifest:media-type'] := 'text/xml';
      Prop['manifest:full-path'] := 'content.xml';
    end;
    with XML.Root.Add do
    begin
      Name := 'manifest:file-entry';
      Prop['manifest:media-type'] := 'text/xml';
      Prop['manifest:full-path'] := 'styles.xml';
    end;
    with XML.Root.Add do
    begin
      Name := 'manifest:file-entry';
      Prop['manifest:media-type'] := 'text/xml';
      Prop['manifest:full-path'] := 'meta.xml';
    end;
    if FExportEMF then
      s := '.emf'
    else
      s := '.bmp';
    FMime := GetFileMIMEType(s);
    for i := 1 to PicCount do
      with XML.Root.Add do
      begin
        Name := 'manifest:file-entry';
        Prop['manifest:media-type'] := FMime;
        Prop['manifest:full-path'] := 'Pictures/Pic' + IntToStr(i) + s;
      end;
    XML.SaveToFile(FileName);
  finally
    XML.Free;
  end;
end;

function TfrxODFExport.OdfPrepareString(const Str: WideString): WideString;
var
  i: Integer;
  s: WideString;
begin
  Result := '';
  s := Str;
  if Copy(s, Length(s) - 1, 4) = #13#10 then
    Delete(s, Length(s) - 1, 4);
  for i := 1 to Length(s) do
  begin
    if s[i] = '&' then
      Result := Result + '&'
    else
    if s[i] = '"' then
      Result := Result + '"'
    else if s[i] = '<' then
      Result := Result + '&lt;'
    else if s[i] = '>' then
      Result := Result + '&gt;'
    else if (s[i] <> #10) then
      Result := Result + s[i]
  end;
end;

function TfrxODFExport.OdfGetFrameName(const FrameStyle:  TfrxFrameStyle): String;
begin
  if FrameStyle = fsDouble then
    Result := 'double'
  else
    Result := 'solid';
end;

procedure TfrxODFExport.OdfMakeHeader(const Item: TfrxXMLItem);
var
  i: Integer;
begin
  for i := 0 to odfHeaderSize - 1 do
    Item.Prop[odfXMLHeader[i][0]] := odfXMLHeader[i][1];
end;

procedure TfrxODFExport.ExportPage(Stream: TStream);
var
  XML: TfrxXMLDocument;
  f: TFileStream;
  s, s1, s2: WideString;
  FList: TStringList;
  i, j, x, y, Page, PicCount: Integer;
  dx, dy, fx, fy: Integer;
  Style: TfrxIEMStyle;
  d: Extended;
  Obj: TfrxIEMObject;
  l : integer;
begin
  if ShowProgress then
    FProgress.Execute(FMatrix.Height - 1, frxResources.Get('ProgressWait'), True, True);
  FTempFolder := GetTempFile;
  DeleteFile(FTempFolder);
  FTempFolder := FTempFolder + '\';
  MkDir(FTempFolder);
  MkDir(FTempFolder + 'Pictures');
  MkDir(FTempFolder + 'Thumbnails');
  PicCount := 0;
  FThumbImage.Picture.SaveToFile(FTempFolder + 'Thumbnails\thumbnail.bmp');
  XML := TfrxXMLDocument.Create;
  try
    XML.AutoIndent := True;
    XML.Root.Name := 'office:document-styles';
    OdfMakeHeader(XML.Root);
    with XML.Root.Add do
    begin
      Name := 'office:automatic-styles';
      with Add do
      begin
        Name := 'style:page-layout';
        Prop['style:name'] := 'pm1';
        with Add do
        begin
          Name := 'style:page-layout-properties';
          Prop['fo:page-width'] := frFloat2Str( FPageWidth / odfPageDiv, 1) + 'cm';
          Prop['fo:page-height'] := frFloat2Str( FPageHeight / odfPageDiv, 1) + 'cm';
          Prop['fo:margin-top'] := frFloat2Str(FPageTop / odfMargDiv, 3) + 'cm';
          Prop['fo:margin-bottom'] := frFloat2Str(FPageBottom / odfMargDiv, 3) + 'cm';
          Prop['fo:margin-left'] := frFloat2Str(FPageLeft / odfMargDiv, 3) + 'cm';
          Prop['fo:margin-right'] := frFloat2Str(FPageRight / odfMargDiv, 3) + 'cm';
        end;