frxexportxml.pas

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

{******************************************}
{                                          }
{             FastReport v4.0              }
{            XML Excel export              }
{                                          }
{         Copyright (c) 1998-2008          }
{          by Alexander Fediachov,         }
{             Fast Reports Inc.            }
{                                          }
{******************************************}
{        Improved by Bysoev Alexander      }
{             [e-mail]            }
{******************************************}

unit frxExportXML;

interface

{$I frx.inc}

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

type
  TfrxXMLExportDialog = 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;
    OpenExcelCB: 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;

  TfrxXMLExport = class(TfrxCustomExportFilter)
  private
    FExportPageBreaks: Boolean;
    FExportStyles: Boolean;
    FFirstPage: Boolean;
    FMatrix: TfrxIEMatrix;
    FOpenExcelAfterExport: Boolean;
    FPageBottom: Extended;
    FPageLeft: Extended;
    FPageRight: Extended;
    FPageTop: Extended;
    FPageOrientation: TPrinterOrientation;
    FProgress: TfrxProgress;
    FShowProgress: Boolean;
    FWysiwyg: Boolean;
    FBackground: Boolean;
    FCreator: String;
    FEmptyLines: Boolean;
    procedure ExportPage(Stream: TStream);
    function ChangeReturns(const Str: String): String;
    function TruncReturns(const Str: WideString): WideString;
  public
    constructor Create(AOwner: TComponent); 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;
  published
    property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
    property ExportPageBreaks: Boolean read FExportPageBreaks write FExportPageBreaks default True;
    property OpenExcelAfterExport: Boolean read FOpenExcelAfterExport
      write FOpenExcelAfterExport 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;


implementation

uses frxUtils, frxFileUtils, frxUnicodeUtils, frxRes, frxrcExports;

{$R *.dfm}

const
  Xdivider = 1.376;
  Ydivider = 1.376;
  MargDiv = 26.6;
  XLMaxHeight = 409;


{ TfrxXMLExport }

constructor TfrxXMLExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FExportPageBreaks := True;
  FExportStyles := True;
  FShowProgress := True;
  FWysiwyg := True;
  FBackground := True;
  FCreator := 'FastReport';
  FilterDesc := frxGet(8105);
  DefaultExt := frxGet(8106);
  FEmptyLines := True;
end;

class function TfrxXMLExport.GetDescription: String;
begin
  Result := frxResources.Get('XlsXMLexport');
end;

function TfrxXMLExport.TruncReturns(const Str: WideString): WideString;
var
  l: Integer;
begin
  l := Length(Str);
  if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
    Result := Copy(Str, 1, l - 2)
  else
    Result := Str;
end;

function TfrxXMLExport.ChangeReturns(const Str: String): String;
var
  i: Integer;
  enc: Boolean;
begin
  Result := '';
  enc := False;
  for i := 1 to Length(Str) do
  begin
    if enc and (Str[i] >= '0') and (Str[i] <= '9') then
      Result := Result + '&#' + IntToStr(Ord(Str[i]))
    else if Str[i] = '&' then
      Result := Result + '&amp;'
    else if (i < Length(Str)) and (Str[i] = #13) and (Str[i + 1] = #10) then
    begin
      enc := True;
      Result := Result + '&#10;'
    end
    else if Str[i] = '"' then
      Result := Result + '&quot;'
    else if Str[i] = '<' then
      Result := Result + '&lt;'
    else if Str[i] = '>' then
      Result := Result + '&gt;'
    else if (Str[i] <> #10) then
    begin
      enc := False;
      Result := Result + Str[i]
    end
  end;
end;

procedure TfrxXMLExport.ExportPage(Stream: TStream);
var
  i, x, y, dx, dy, fx, fy, Page: Integer;
  s: WideString;
  sb, si, su, decsep, thsep: String;
  dcol, drow: Extended;
  Vert, Horiz: String;
  obj: TfrxIEMObject;
  EStyle: TfrxIEMStyle;
  St: String;
  PageBreak: TStringList;

  function IsDigits(const Str: String): Boolean;
  var
    i: Integer;
  begin
    Result := True;
    for i := 1 to Length(Str) do
      if not((AnsiChar(Str[i]) in ['0'..'9', ',' ,'.' ,'-', ' ', '