qexport4docx.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4Docx;

interface

uses Classes, QExport4, BaseArchiveClass4, QExport4IniFiles,
  QXMLWriter, QExport4Types
  {$IFNDEF NOGUI}, Graphics{$ELSE}, QExport4Graphics{$ENDIF},
  ExtCtrls, QExport4MSOfficeCommon;

type
  TDocxBorder = class(TPersistent)
  private
    FStyle: TDocxBorderStyle;
    FColor: TColor;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Default;
  published
    property Style: TDocxBorderStyle read FStyle
      write FStyle default dbsSingle;
    property Color: TColor read FColor write FColor
      default clBlack;
  end;

  TDocxCellStyle = class;

  TDocxStripStyle = class(TCollectionItem)
  private
    FOptions: TDocxCellStyle;
    procedure SetOptions(const Value: TDocxCellStyle);
  published
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Options: TDocxCellStyle read FOptions
      write SetOptions;
  end;

  TDocxStripStyleList = class(TCollection)
  private
    function GetItem(Index: Integer): TDocxStripStyle;
    procedure SetItem(Index: Integer; Value: TDocxStripStyle);
  public
    function Add: TDocxStripStyle;
    property Items[Index: Integer]: TDocxStripStyle read GetItem
      write SetItem; default;
  end;

  TDocxCellStyle = class(TPersistent)
  private
    FFont: TFont;
    FUseBackground: boolean;
    FBackgroundColor: TColor;
    FUseHighlight: boolean;
    FHighlightColor: TMSHighlightColor;
    FAlignment: TMSCellAlignment;
    function GetIsDefault: Boolean;
    procedure SetDefault(const Value: Boolean);
    procedure SetFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    procedure LoadFromIni(IniFile: TQIniFile; const Section: WideString);
    procedure SaveToIni(IniFile: TQIniFile; const Section: WideString);
    procedure Default; virtual;
    property IsDefault: Boolean read GetIsDefault write SetDefault;
  published
    property Font: TFont read FFont write SetFont;

    property UseBackground: boolean read FUseBackground
      write FUseBackground default False;
    property BackgroundColor: TColor read FBackgroundColor
      write FBackgroundColor default clWhite;
    property UseHighlight: boolean read FUseHighlight
      write FUseHighlight default False;
    property HighlightColor: TMSHighlightColor read FHighlightColor
      write FHighlightColor default hcNone;

    property Alignment: TMSCellAlignment read FAlignment
      write FAlignment default caLeft;
  end;

  TQExport4DocxOptions = class(TPersistent)
  private
    FHeaderStyle: TDocxCellStyle;
    FFooterStyle: TDocxCellStyle;
    FCaptionRowStyle: TDocxCellStyle;
    FDataStyle: TDocxCellStyle;
    FStripStyle: TMSStripStyleType;
    FStripStylesList: TDocxStripStyleList;
    FBorder: TDocxBorder;
    FUseBorder: Boolean;
    procedure SetHeaderStyle(const Value: TDocxCellStyle);
    procedure SetCaptionStyle(const Value: TDocxCellStyle);
    procedure SetDataStyle(const Value: TDocxCellStyle);
    procedure SetStripStyles(const Value: TDocxStripStyleList);
    procedure SetFooterStyle(const Value: TDocxCellStyle);
    procedure SetBorder(const Value: TDocxBorder);
  public
    constructor Create(Holder: TPersistent);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property HeaderStyle: TDocxCellStyle read FHeaderStyle
      write SetHeaderStyle;
    property CaptionRowStyle: TDocxCellStyle read FCaptionRowStyle
      write SetCaptionStyle;
    property DataStyle: TDocxCellStyle read FDataStyle
      write SetDataStyle;
    property StripStyleType: TMSStripStyleType read FStripStyle
      write FStripStyle default ssNone;
    property StripStylesList: TDocxStripStyleList read FStripStylesList
      write SetStripStyles;
    property FooterStyle: TDocxCellStyle read FFooterStyle
      write SetFooterStyle;

    property UseBorder: Boolean read FUseBorder write FUseBorder
      default False;
    property Border: TDocxBorder read FBorder write SetBorder;
  end;

  TDocxFileMaker = class
  private
    FOwner: TQExport4;
    FExportStream: TStream;
    FExportWriter: TQXMLWriter;

    FZipper: TBaseArchiveClass;
    FExportFileName: WideString;
    FTempDir: WideString;
    FFooter: TStrings;
    FHeader: TStrings;

    FColumnsCount: Integer;
    FIsColumnsSectionReady: Boolean;
    procedure SetIsColumnsSectionReady(const Value: Boolean);
    procedure AddCell(Value: WideString; CellStyle: TDocxCellStyle;
      Border: TDocxBorder);
    procedure AddRow(Number: Integer; CaptionRow: TQExportColumns;
      CellStyle: TDocxCellStyle; Border: TDocxBorder = nil); overload;
    procedure AddRow(Number: Integer; ExportRow: TQExportRow;
      CellStyle: TDocxCellStyle; Border: TDocxBorder = nil); overload;
    procedure AddRow(Number: Integer; Value: WideString;
      CellStyle: TDocxCellStyle); overload;

    procedure CreateDirsStructure;
    function IsExistDirsStructure: Boolean;
  public
    constructor Create(AOwner: TQExport4; ExportFile: WideString);
    destructor Destroy; override;

    procedure FillCommonData;
    procedure CompressFile;
    procedure PrepareExport;
    procedure FinishExport;

    property ColumnsCount: Integer read FColumnsCount write FColumnsCount;
    property IsColumnsSectionReady: Boolean read FIsColumnsSectionReady
      write SetIsColumnsSectionReady;
    property ExportFileName: WideString read FExportFileName;
    property Header: TStrings read FHeader;
    property Footer: TStrings read FFooter;
  end;

  TQExport4Docx = class(TQExport4FormatText)
  private
    FDocxOptions: TQExport4DocxOptions;
    procedure SetDocxOptions(const Value: TQExport4DocxOptions);
  private
    FCounter: Integer;
    FRowCounter: Integer;
    FDocxFile: TDocxFileMaker;
    procedure WriteHeader;
    procedure WriteFooter;
  protected
    procedure BeginExport; override;
    procedure BeforeExport; override;
    procedure AfterExport; override;
    procedure EndExport; override;

    procedure WriteCaptionRow; override;
    procedure WriteDataRow; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    procedure Execute; override;
  published
    property DocxOptions: TQExport4DocxOptions read FDocxOptions write SetDocxOptions;
  end;

procedure DrawDocxCell(PaintBox: TPaintBox; CellStyle: TDocxCellStyle);

implementation

uses
  SysUtils{$IFDEF VCL6}, StrUtils{$ENDIF}, QExport4Common
  {$IFDEF VER130}, FileCtrl{$ENDIF};

procedure DrawDocxCell(PaintBox: TPaintBox; CellStyle: TDocxCellStyle);

  procedure FillBackground;
  begin
    if CellStyle.UseBackground then
      PaintBox.Canvas.Brush.Color := CellStyle.BackgroundColor
    else
      PaintBox.Canvas.Brush.Color := clWhite;
    PaintBox.Canvas.FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;

const
  OutText = 'Aa Zz';
var
  X: integer;
begin
  if not Assigned(CellStyle) then Exit;

  FillBackground;
  with PaintBox.Canvas.Font do
  begin
    Name := CellStyle.Font.Name;
    Size := CellStyle.Font.Size;
    Charset := CellStyle.Font.Charset;
    Color := CellStyle.Font.Color;
    Style := CellStyle.Font.Style;
  end;

  case CellStyle.Alignment of
    caLeft, caJustify: X := 5;
    caCenter: X := (PaintBox.Width - PaintBox.Canvas.TextWidth(OutText)) div 2;
    caRight: X := PaintBox.Width - 5 - PaintBox.Canvas.TextWidth(OutText);
    else
      X := 0;
  end;

  PaintBox.Canvas.TextOut(X, 0, OutText);
end;

{ TDocxBorder }

constructor TDocxBorder.Create;
begin
  Default;
end;

procedure TDocxBorder.Assign(Source: TPersistent);
begin
  if Source is TDocxBorder then
  begin
    Style := (Source as TDocxBorder).Style;
    Color := (Source as TDocxBorder).Color;
  end;
end;

procedure TDocxBorder.Default;
begin
  FStyle := dbsSingle;
  FColor := clBlack;
end;

{ TDocxStripStyle }

procedure TDocxStripStyle.SetOptions(const Value: TDocxCellStyle);
begin
  FOptions.Assign(Value);
end;

constructor TDocxStripStyle.Create(Collection: TCollection);
begin
  inherited;
  FOptions := TDocxCellStyle.Create;
end;

destructor TDocxStripStyle.Destroy;
begin
  FOptions.Free;
  inherited;
end;

procedure TDocxStripStyle.Assign(Source: TPersistent);
begin
  FOptions.Assign(TDocxStripStyle(Source).Options);
end;