unit QExport4Docx;
{$I QExport4VerCtrl.inc}
interface

uses
  {$IFDEF VCL16}
    System.Classes,
    Vcl.Graphics,
    Vcl.ExtCtrls,
    Data.DB,
  {$ELSE}
    Classes,
    Graphics,
    ExtCtrls,
    DB,
  {$ENDIF}
  QExport4,
  QExport4BaseArchiveClass,
  QExport4IniFiles,
  QXMLWriter,
  QExport4Types,
  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;
    FPageOrientation: TQExportPageOrientation;
    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;
    property PageOrientation: TQExportPageOrientation read FPageOrientation
      write FPageOrientation default poPortrait;
  end;

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

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

    FColumnsCount: Integer;
    FRelsStream: TStream;
    FRelsWriter: TQXMLWriter;
    FIsColumnsSectionReady: Boolean;
    FContentStream: TStream;
    FContentWriter: TQXMLWriter;
    FImageTypes: TQEImagePartTypes;
    procedure SetIsColumnsSectionReady(const Value: Boolean);
    procedure AddTextCell(const Value: WideString; CellStyle: TDocxCellStyle;
        Border: TDocxBorder);
    procedure AddCell(ExportCol: TQExportCol; CellStyle: TDocxCellStyle; Border:
        TDocxBorder);
    procedure AddImageCell(const FileName, RelsId: QEString; Id, Height, Width:
        Integer; CellStyle: TDocxCellStyle; Border: TDocxBorder);
    procedure AddImagePart(const FileName, RelsId: QEString; ImagePartType:
        TQEImagePartType; Data: TBlobField);
    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 AddBinaryCell(Data: TField; CellStyle: TDocxCellStyle; Border:
        TDocxBorder);

    procedure CreateDirsStructure;
    procedure DefineAlignment(CellStyle: TDocxCellStyle);
    procedure DefineBackground(CellStyle: TDocxCellStyle);
    procedure DefineBorder(Border: TDocxBorder);
    procedure DefineFont(CellStyle: TDocxCellStyle);
    function IsExistDirsStructure: Boolean;
  public
    constructor Create(AOwner: TQExport4; ExportFile: WideString);
    destructor Destroy; override;
    procedure PrepareCommonData;
    procedure FinishCommonData;
    procedure CompressFile;
    procedure PrepareExport;
    procedure FinishExport(const APageOrientation: TQExportPageOrientation);

    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(TQExport4AdvancedText)
  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 FillExportCol(Index: Integer); override;
    procedure WriteCaptionRow; override;
    procedure WriteDataRow; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    procedure Execute; override;
  published
    property AllowCaptions;
    property Captions;
    property UserFormats;
    property DocxOptions: TQExport4DocxOptions read FDocxOptions write SetDocxOptions;
  end;

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

implementation

uses
  {$IFDEF VCL16}
    System.SysUtils,
    System.StrUtils,
    System.Variants,
    Vcl.Imaging.jpeg,
    Vcl.Imaging.gifimg,
    Vcl.Imaging.pngimage,
    {$IFDEF VCL21}
    System.NetEncoding,
    {$ELSE}
    Soap.EncdDecd,
    {$ENDIF}
    Winapi.Windows,
    {$IFDEF VER130}
      Vcl.FileCtrl,
    {$ENDIF}
  {$ELSE}
    SysUtils,
    Windows,
    {$IFDEF VCL6}
      StrUtils,
      Variants,
      EncdDecd,
    {$ENDIF}
    {$IFDEF VER130}
      FileCtrl,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF VCL17}
    System.UITypes,
  {$ENDIF}
  QExport4Common;

const
  cRelsId = 'rId';
  cRelsIdStart = 5;
  cImageName = 'image';

var
  ScreenHResolution,
  ScreenVResolution: Integer;

type
  TImageRec = record
    Data: TField;
    ImagePartType: TQEImagePartType;
    Height: Integer;
    Width: Integer;
  end;

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;

procedure InitScreenResolutions;
var
  DC: HDC;
begin
  DC := GetDC(0);
  try
    ScreenHResolution := Trunc(DefaultEMUPerInch / GetDeviceCaps(DC, LOGPIXELSX));
    ScreenVResolution := Trunc(DefaultEMUPerInch / GetDeviceCaps(DC, LOGPIXELSY));
  finally
    ReleaseDC(0,DC);
  end;
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;

{ TDocxStripStyleList }

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

procedure TDocxStripStyleList.SetItem(Index: Integer;
  Value: TDocxStripStyle);
begin
  inherited Items[Index] := Value;
end;

function TDocxStripStyleList.Add: TDocxStripStyle;
begin
  Result := TDocxStripStyle(inherited Add)
end;

{ TDocxCellStyle }

function TDocxCellStyle.GetIsDefault: Boolean;
begin
  Result := (FFont.Name = 'Calibri')
    and (FFont.Size = 11)
    and (FFont.Style = [])
    and (FFont.Color = clBlack)
    and (FBackgroundColor = clWhite)
    and (FUseBackground = False)
    and (FAlignment = caLeft);
end;

procedure TDocxCellStyle.SetDefault(const Value: Boolean);
begin
  if Value then
  begin
    FFont.Name := 'Calibri';
    FFont.Size := 11;
    FFont.Style := [];
    FFont.Color := clBlack;
    FBackgroundColor := clWhite;
    FUseBackground := False;
    FAlignment := caLeft;
  end;
end;

procedure TDocxCellStyle.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

constructor TDocxCellStyle.Create;
begin
  FFont := TFont.Create;
  Default;
end;

destructor TDocxCellStyle.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TDocxCellStyle.Assign(Source: TPersistent);
begin
  if Source is TDocxCellStyle then
  begin
    Font := TDocxCellStyle(Source).Font;
    UseBackground := TDocxCellStyle(Source).UseBackground;
    BackgroundColor := TDocxCellStyle(Source).BackgroundColor;
    UseHighlight := TDocxCellStyle(Source).UseHighlight;
    HighlightColor := TDocxCellStyle(Source).HighlightColor;
    Alignment := TDocxCellStyle(Source).Alignment;
  end;
end;

procedure TDocxCellStyle.LoadFromIni(IniFile: TQIniFile;
  const Section: WideString);
begin
  with IniFile do
  begin
    Font.Name := ReadString(Section, S_DOCX_FontName, 'Calibri');
    Font.Size := ReadInteger(Section, S_DOCX_FontSize, 11);
    Font.Color := ReadInteger(Section, S_DOCX_FontColor, clBlack);
    if ReadBool(Section, S_DOCX_FontBold, False) then
      Font.Style := Font.Style + [fsBold]
    else
      Font.Style := Font.Style - [fsBold];
    if ReadBool(Section, S_DOCX_FontItalic, False) then
      Font.Style := Font.Style + [fsItalic]
    else
      Font.Style := Font.Style - [fsItalic];
    if ReadBool(Section, S_DOCX_FontUnderline, False) then
      Font.Style := Font.Style + [fsUnderline]
    else
      Font.Style := Font.Style - [fsUnderline];
    if ReadBool(Section, S_DOCX_StrikeOut, False) then
      Font.Style := Font.Style + [fsStrikeOut]
    else
      Font.Style := Font.Style - [fsStrikeOut];
    Alignment := TMSCellAlignment(ReadInteger(Section, S_DOCX_HorAlignment, 0));
    UseBackground := ReadBool(Section, S_DOCX_UseBackground, False);
    BackgroundColor := ReadInteger(Section, S_DOCX_BackgroundColor, clBlack);
  end;
end;

procedure TDocxCellStyle.SaveToIni(IniFile: TQIniFile;
  const Section: WideString);
begin
  with IniFile do
  begin
    WriteString(Section, S_DOCX_FontName, Font.Name);
    WriteInteger(Section, S_DOCX_FontSize, Font.Size);
    WriteInteger(Section, S_DOCX_FontColor, Font.Color);
    if fsBold in Font.Style then
      WriteBool(Section, S_DOCX_FontBold, true)
    else
      WriteBool(Section, S_DOCX_FontBold, false);
    if fsItalic in Font.Style then
      WriteBool(Section, S_DOCX_FontItalic, true)
    else
      WriteBool(Section, S_DOCX_FontItalic, false);
    if fsUnderline in Font.Style then
      WriteBool(Section, S_DOCX_FontUnderline, true)
    else
      WriteBool(Section, S_DOCX_FontUnderline, false);
    if fsStrikeOut in Font.Style then
      WriteBool(Section, S_DOCX_StrikeOut, true)
    else
      WriteBool(Section, S_DOCX_StrikeOut, false);
    WriteBool(Section, S_DOCX_UseBackground, UseBackground);
    WriteInteger(Section, S_DOCX_BackgroundColor, BackgroundColor);
    WriteInteger(Section, S_DOCX_HorAlignment, Integer(Alignment));
    WriteBool(Section, S_DOCX_UseHighlight, UseBackground);
    WriteInteger(Section, S_DOCX_HighlightColor, Integer(HighlightColor));
  end;
end;

procedure TDocxCellStyle.Default;
begin
  FFont.Name := 'Calibri';
  FFont.Size := 11;
  FFont.Style := [];
  FFont.Color := clBlack;
  FUseBackground := False;
  FBackgroundColor := clWhite;
  FUseHighlight := False;
  FHighlightColor := hcNone;
  FAlignment := caLeft;
end;

{ TQExport4DocxOptions }

procedure TQExport4DocxOptions.SetHeaderStyle(const Value: TDocxCellStyle);
begin
  FHeaderStyle.Assign(Value);
end;

procedure TQExport4DocxOptions.SetCaptionStyle(
  const Value: TDocxCellStyle);
begin
  FCaptionRowStyle.Assign(Value);
end;

procedure TQExport4DocxOptions.SetDataStyle(const Value: TDocxCellStyle);
begin
  FDataStyle.Assign(Value);
end;

procedure TQExport4DocxOptions.SetStripStyles(
  const Value: TDocxStripStyleList);
begin
  FStripStylesList.Assign(Value);
end;

procedure TQExport4DocxOptions.SetFooterStyle(const Value: TDocxCellStyle);
begin
  FFooterStyle.Assign(Value);
end;

procedure TQExport4DocxOptions.SetBorder(const Value: TDocxBorder);
begin
  FBorder.Assign(Value);
end;

constructor TQExport4DocxOptions.Create(Holder: TPersistent);
begin
  inherited Create;
  FHeaderStyle := TDocxCellStyle.Create;
  FCaptionRowStyle := TDocxCellStyle.Create;
  FDataStyle := TDocxCellStyle.Create;
  FStripStyle := ssNone;
  FStripStylesList := TDocxStripStyleList.Create(TDocxStripStyle);
  FFooterStyle := TDocxCellStyle.Create;
  FUseBorder := False;
  FBorder := TDocxBorder.Create;
  FPageOrientation := poPortrait;
end;

destructor TQExport4DocxOptions.Destroy;
begin
  FHeaderStyle.Free;
  FCaptionRowStyle.Free;
  FDataStyle.Free;
  FStripStylesList.Free;
  FFooterStyle.Free;
  FBorder.Free;
  inherited;
end;

procedure TQExport4DocxOptions.Assign(Source: TPersistent);
begin
  if Source is TQExport4DocxOptions then
  begin
    HeaderStyle := TQExport4DocxOptions(Source).HeaderStyle;
    CaptionRowStyle := TQExport4DocxOptions(Source).CaptionRowStyle;
    DataStyle := TQExport4DocxOptions(Source).DataStyle;
    StripStyleType := TQExport4DocxOptions(Source).StripStyleType;
    StripStylesList := TQExport4DocxOptions(Source).StripStylesList;
    FooterStyle := TQExport4DocxOptions(Source).FooterStyle;
    UseBorder := TQExport4DocxOptions(Source).UseBorder;
    if UseBorder then
    begin
      Border.Style := TQExport4DocxOptions(Source).Border.Style;
      Border.Color := TQExport4DocxOptions(Source).Border.Color;
    end;
    PageOrientation := TQExport4DocxOptions(Source).PageOrientation;
  end;
end;

{ TDocxFileMaker }

procedure TDocxFileMaker.SetIsColumnsSectionReady(const Value: Boolean);
var
  i: Integer;
begin
  if Value then
  begin
    FExportWriter.BeginNode('w:tblGrid');
    for i := 0 to FColumnsCount - 1 do
      FExportWriter.CreateFullNode('w:gridCol', ['w:w'], ['2392']);
    FExportWriter.EndNode(false);
    FIsColumnsSectionReady := Value;
  end;
end;

procedure TDocxFileMaker.AddTextCell(const Value: WideString; CellStyle:
    TDocxCellStyle; Border: TDocxBorder);
begin
  with FExportWriter do
  begin
    BeginNode('w:tc');
      BeginNode('w:tcPr');
        CreateFullNode('w:tcW', ['w:w', 'w:type'], ['2392', 'dxa']);
        DefineBorder(Border);
        DefineBackground(CellStyle);
      EndNode(false); //w:tcPr
      BeginNode('w:p');
        BeginNode('w:pPr');
          DefineAlignment(CellStyle);
          BeginNode('w:rPr');
            CreateFullNode('w:lang', ['w:val'], ['en-US']);
          EndNode(false); //w:rPr
        EndNode(false); //w:pPr
        BeginNode('w:r', ['w:rsidR'], ['003E55F7']);
          DefineFont(CellStyle);
          CreateFullNode('w:t', ReplaceSymbols(Value, True));
        EndNode(false); //w:r
      EndNode(false); //w:p
    EndNode(false); //w:tc
  end;
end;

procedure TDocxFileMaker.AddRow(Number: Integer; CaptionRow: TQExportColumns;
  CellStyle: TDocxCellStyle; Border: TDocxBorder = nil);
var
  i: Integer;
begin
  with FExportWriter do
  begin
    BeginNode('w:tr', ['w:rsidR', 'w:rsidTr'], ['003E55F7', '003E55F7']);
    for i := 0 to CaptionRow.Count - 1 do
      AddTextCell(CaptionRow[i].Caption, CellStyle, Border);
    EndNode(false);
  end;
end;

procedure TDocxFileMaker.AddRow(Number: Integer; ExportRow: TQExportRow;
  CellStyle: TDocxCellStyle; Border: TDocxBorder = nil);
var
  i: Integer;
begin
  with FExportWriter do
  begin
    BeginNode('w:tr', ['w:rsidR', 'w:rsidTr'], ['003E55F7', '003E55F7']);
    for i := 0 to ExportRow.Count - 1 do
      AddCell(ExportRow[i], CellStyle, Border);
    EndNode(false);
  end;
end;

procedure TDocxFileMaker.AddRow(Number: Integer; Value: WideString;
  CellStyle: TDocxCellStyle);
begin
  with FExportWriter do
  begin
    BeginNode('w:tr', ['w:rsidR', 'w:rsidTr'], ['003E55F7', '003E55F7']);
    AddTextCell(Value, CellStyle, nil);
    EndNode(false);
  end;
end;

constructor TDocxFileMaker.Create(AOwner: TQExport4; ExportFile: WideString);
begin
  FOwner := AOwner;
  FExportFileName := ExportFile;
  FTempDir := GetTempDir;
  FHeader := TStringList.Create;
  FFooter := TStringList.Create;
  FIsColumnsSectionReady := False;
  FColumnsCount := 0;
end;

destructor TDocxFileMaker.Destroy;
begin
  FHeader.Free;
  FFooter.Free;
  inherited;
end;

procedure TDocxFileMaker.AddCell(ExportCol: TQExportCol; CellStyle:
    TDocxCellStyle; Border: TDocxBorder);
var
  IR: TImageRec;
  P: Pointer;
  Data: Variant;
  RelsId, FileName: qeString;
begin
  if not Assigned(ExportCol) then
    Exit;
  Data := ExportCol.Data;
  if VarIsArray(Data) then
  begin
    P := VarArrayLock(Data);
    try
      Move(P^ ,IR, SizeOf(IR));
    finally
      VarArrayUnlock(Data);
    end;
    if IR.ImagePartType <> iptUnknown then
    begin
      if FBlobCounter = 0 then
        InitScreenResolutions;
      Inc(FBlobCounter);
      RelsId := cRelsId + IntToStr(FBlobCounter + cRelsIdStart);
      FileName := cImageName + IntToStr(FBlobCounter);
      AddImagePart(FileName, RelsId, IR.ImagePartType, IR.Data as TBlobField);
      AddImageCell(FileName, RelsId, FBlobCounter, IR.Height * ScreenVResolution,
        IR.Width * ScreenHResolution, CellStyle, Border);
    end
    else
      AddBinaryCell(IR.Data, CellStyle, Border);
  end
  else
    AddTextCell(FOwner.GetExportedValue(ExportCol), CellStyle, Border);
end;

procedure TDocxFileMaker.AddImageCell(const FileName, RelsId: QEString; Id,
    Height, Width: Integer; CellStyle: TDocxCellStyle; Border: TDocxBorder);
begin
  with FExportWriter do
  begin
    BeginNode('w:tc');
      BeginNode('w:tcPr');
        CreateFullNode('w:tcW', ['w:w', 'w:type'], ['2392', 'dxa']);
        DefineBorder(Border);
        DefineBackground(CellStyle);
      EndNode(false); //w:tcPr
      BeginNode('w:p');
        BeginNode('w:pPr');
          DefineAlignment(CellStyle);
          BeginNode('w:rPr');
            CreateFullNode('w:lang', ['w:val'], ['en-US']);
          EndNode(false); //w:rPr
        EndNode(false); //w:pPr
        BeginNode('w:r', ['w:rsidR'], ['003E55F7']);
          BeginNode('w:rPr');
            CreateFullNode('w:noProof');
          EndNode(false); //w:rPr
          BeginNode('w:drawing', ['xmlns:w'], ['http://schemas.openxmlformats.org/wordprocessingml/2006/main']);
            BeginNode('wp:inline', ['xmlns:wp'], ['http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing']);
              CreateFullNode('wp:extent', ['cx', 'cy'], [IntToStr(Width), IntToStr(Height)]);
              CreateFullNode('wp:docPr', ['id', 'name'], [IntToStr(Id), FileName]);
              BeginNode('a:graphic', ['xmlns:a'], ['http://schemas.openxmlformats.org/drawingml/2006/main']);
                BeginNode('a:graphicData', ['uri'], ['http://schemas.openxmlformats.org/drawingml/2006/picture']);
                  BeginNode('pic:pic', ['xmlns:pic'], ['http://schemas.openxmlformats.org/drawingml/2006/picture']);
                    BeginNode('pic:nvPicPr');
                      CreateFullNode('pic:cNvPr', ['id', 'name'], [IntToStr(Id), FileName]);
                      BeginNode('pic:cNvPicPr');
                        CreateFullNode('a:picLocks', ['noChangeAspect'], ['1']);
                      EndNode(false); //pic:cNvPicPr
                    EndNode(false); //pic:nvPicPr
                    BeginNode('pic:blipFill');
                      CreateFullNode('a:blip', ['r:embed', 'xmlns:r'],
                        [RelsId, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships']);
                      BeginNode('a:stretch');
                        CreateFullNode('a:fillRect');
                      EndNode(false); //a:stretch
                    EndNode(false); //pic:blipFill
                    BeginNode('pic:spPr');
                      BeginNode('a:xfrm');
                        CreateFullNode('a:off', ['x', 'y'], ['0', '0']);
                        CreateFullNode('a:ext', ['cx', 'cy'], [IntToStr(Width), IntToStr(Height)]);
                      EndNode(false); //a:xfrm
                      CreateFullNode('a:prstGeom', ['prst'], ['rect']);
                    EndNode(false); //pic:spPr
                  EndNode(false); //pic:pic
                EndNode(false); //a:graphicData
              EndNode(false); //a:graphic
            EndNode(false); //wp:inline
          EndNode(false); //w:drawing
        EndNode(false); //w:r
      EndNode(false); //w:p
    EndNode(false); //w:tc
  end;
end;

procedure TDocxFileMaker.AddImagePart(const FileName, RelsId: QEString;
    ImagePartType: TQEImagePartType; Data: TBlobField);
var
  S: WideString;
begin
  if not Assigned(FRelsWriter) then
    Exit;
  Include(FImageTypes, ImagePartType);
  S := ImagePartTypeToExt(ImagePartType);
  if S <> '' then
    S := '.' + S;
  S := ChangeFileExt(FileName, S);
  FRelsWriter.CreateFullNode('Relationship', ['Id', 'Type', 'Target'],
    [RelsId, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image', 'media/' + S]);
  Data.SaveToFile(FTempDir + '\word\media\' + S);
end;

procedure TDocxFileMaker.AddBinaryCell(Data: TField; CellStyle: TDocxCellStyle;
    Border: TDocxBorder);
{$IFDEF VCL6}
var
  BlobStream: TStream;
  DataStream: TStringStream;
{$ENDIF}
begin
  if not Assigned(Data) then
    Exit;
  with FExportWriter do
  begin
    BeginNode('w:tc');
      BeginNode('w:tcPr');
        CreateFullNode('w:tcW', ['w:w', 'w:type'], ['2392', 'dxa']);
        DefineBorder(Border);
        DefineBackground(CellStyle);
      EndNode(false); //w:tcPr
      BeginNode('w:p');
        BeginNode('w:pPr');
          DefineAlignment(CellStyle);
          BeginNode('w:rPr');
            CreateFullNode('w:lang', ['w:val'], ['en-US']);
          EndNode(false); //w:rPr
        EndNode(false); //w:pPr
        BeginNode('w:r', ['w:rsidR'], ['003E55F7']);
          DefineFont(CellStyle);
        {$IFDEF VCL6}
          BlobStream := Data.DataSet.CreateBlobStream(Data, bmRead);
          try
            DataStream := TStringStream.Create('');
            try
              {$IFDEF VCL21}
              TNetEncoding.Base64.Encode(BlobStream, DataStream);
              {$ELSE}
              {$IFDEF VCL16}Soap.{$ENDIF}EncdDecd.EncodeStream(BlobStream, DataStream); //encode to base64
              CreateFullNode('w:t', DataStream.DataString);
              {$ENDIF}
            finally
              DataStream.Free;
            end;                                        
          finally
            BlobStream.Free;
          end;
        {$ELSE}
          CreateFullNode('w:t', Data.AsString);
        {$ENDIF}
        EndNode(false); //w:r
      EndNode(false); //w:p
    EndNode(false); //w:tc
  end;
end;

procedure TDocxFileMaker.CreateDirsStructure;
begin
  ForceDirectories(FTempDir);
  ForceDirectories(FTempDir + '\_rels');
  ForceDirectories(FTempDir + '\docProps');
  ForceDirectories(FTempDir + '\word');
  ForceDirectories(FTempDir + '\word\_rels');
  ForceDirectories(FTempDir + '\word\theme');
  ForceDirectories(FTempDir + '\word\media');
end;

function TDocxFileMaker.IsExistDirsStructure: Boolean;
begin
  Result := DirectoryExists(FTempDir)
    and DirectoryExists(FTempDir + '\_rels')
    and DirectoryExists(FTempDir + '\docProps')
    and DirectoryExists(FTempDir + '\word')
    and DirectoryExists(FTempDir + '\word\_rels')
    and DirectoryExists(FTempDir + '\word\theme')
    and DirectoryExists(FTempDir + '\word\media');
end;

procedure TDocxFileMaker.PrepareCommonData;
var
  Stream: TStream;
begin
  //FTempDir + '\_rels\.rels'
  Stream := TFileStream.Create(FTempDir + '\_rels\.rels', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('Relationships', ['xmlns'], ['http://schemas.openxmlformats.org/package/2006/relationships']);
          CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId3', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties', 'docProps/app.xml']);
          CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId2', 'http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties', 'docProps/core.xml']);
          CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId1', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument', 'word/document.xml']);
        EndNode(); //Relationships
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\docProps\app.xml'
  Stream := TFileStream.Create(FTempDir + '\docProps\app.xml', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('Properties', ['xmlns', 'xmlns:vt'], ['http://schemas.openxmlformats.org/officeDocument/2006/extended-properties', 'http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes']);
          CreateFullNode('Template', 'Normal.dotm');
          CreateFullNode('TotalTime', '1');
          CreateFullNode('Pages', '1');
          CreateFullNode('Words', '0');
          CreateFullNode('Characters', '0');
          CreateFullNode('Application', 'Microsoft Office Word');
          CreateFullNode('DocSecurity', '0');
          CreateFullNode('Lines', '1');
          CreateFullNode('Paragraphs', '1');
          CreateFullNode('ScaleCrop', 'false');
          CreateFullNode('Company');
          CreateFullNode('LinksUpToDate', 'false');
          CreateFullNode('CharactersWithSpaces', '0');
          CreateFullNode('SharedDoc', 'false');
          CreateFullNode('HyperlinksChanged', 'false');
          CreateFullNode('AppVersion', '12.0000');
        EndNode(); //Properties
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\docProps\core.xml'
  Stream := TFileStream.Create(FTempDir + '\docProps\core.xml', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('cp:coreProperties', ['xmlns:cp', 'xmlns:dc', 'xmlns:dcterms', 'xmlns:dcmitype', 'xmlns:xsi'],
          ['http://schemas.openxmlformats.org/package/2006/metadata/core-properties', 'http://purl.org/dc/elements/1.1/',
          'http://purl.org/dc/terms/', 'http://purl.org/dc/dcmitype/', 'http://www.w3.org/2001/XMLSchema-instance']);
          CreateFullNode('dc:title');
          CreateFullNode('dc:subject');
          CreateFullNode('dc:creator', 'User');
          CreateFullNode('cp:keywords');
          CreateFullNode('dc:description');
          CreateFullNode('cp:lastModifiedBy', 'User');
          CreateFullNode('cp:revision', '1');
          CreateFullNode('dcterms:created', ['xsi:type'], ['dcterms:W3CDTF'], '2006-10-09T09:46:00Z');
          CreateFullNode('dcterms:modified', ['xsi:type'], ['dcterms:W3CDTF'], '2006-10-09T09:47:00Z');
        EndNode(); //cp:coreProperties
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\word\_rels\document.xml.rels'
  FRelsStream := TFileStream.Create(FTempDir + '\word\_rels\document.xml.rels', fmCreate);
  FRelsWriter := TQXMLWriter.Create(FRelsStream);
  FRelsWriter.CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
  FRelsWriter.BeginNode('Relationships', ['xmlns'], ['http://schemas.openxmlformats.org/package/2006/relationships']);
  FRelsWriter.CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId3', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/webSettings', 'webSettings.xml']);
  FRelsWriter.CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId2', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/settings', 'settings.xml']);
  FRelsWriter.CreateFullNode('Relationship', ['Id', 'Type', 'Target'], ['rId4', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/fontTable', 'fontTable.xml']);

  //FTempDir + '\word\document.xml'
  //DO in BeforeExport + FinishExport

  //FTempDir + '\word\fontTable.xml'
  Stream := TFileStream.Create(FTempDir + '\word\fontTable.xml', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('w:fonts', ['xmlns:r', 'xmlns:w'], ['http://schemas.openxmlformats.org/officeDocument/2006/relationships','http://schemas.openxmlformats.org/wordprocessingml/2006/main']);
          BeginNode('w:font', ['w:name'], ['Calibri']);
            CreateFullNode('w:panose1', ['w:val'], ['020F0502020204030204']);
            CreateFullNode('w:charset', ['w:val'], ['CC']);
            CreateFullNode('w:family', ['w:val'], ['swiss']);
            CreateFullNode('w:pitch', ['w:val'], ['variable']);
            CreateFullNode('w:sig', ['w:usb0', 'w:usb1', 'w:usb2', 'w:usb3', 'w:csb0', 'w:csb1'],
              ['A00002EF', '4000207B', '00000000', '00000000', '0000009F', '00000000']);
          EndNode(); //w:font
          BeginNode('w:font', ['w:name'], ['Times New Roman']);
            CreateFullNode('w:panose1', ['w:val'], ['02020603050405020304']);
            CreateFullNode('w:charset', ['w:val'], ['CC']);
            CreateFullNode('w:family', ['w:val'], ['roman']);
            CreateFullNode('w:pitch', ['w:val'], ['variable']);
            CreateFullNode('w:sig', ['w:usb0', 'w:usb1', 'w:usb2', 'w:usb3', 'w:csb0', 'w:csb1'],
              ['20002A87', '80000000', '00000008', '00000000', '000001FF', '00000000']);
          EndNode(); //w:font
          BeginNode('w:font', ['w:name'], ['Cambria']);
            CreateFullNode('w:panose1', ['w:val'], ['02040503050406030204']);
            CreateFullNode('w:charset', ['w:val'], ['CC']);
            CreateFullNode('w:family', ['w:val'], ['roman']);
            CreateFullNode('w:pitch', ['w:val'], ['variable']);
            CreateFullNode('w:sig', ['w:usb0', 'w:usb1', 'w:usb2', 'w:usb3', 'w:csb0', 'w:csb1'],
              ['A00002EF', '4000004B', '00000000', '00000000', '0000009F', '00000000']);
          EndNode(); //w:font
        EndNode(); //w:fonts
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\word\settings.xml'
  Stream := TFileStream.Create(FTempDir + '\word\settings.xml', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('w:settings', ['xmlns:o', 'xmlns:r', 'xmlns:m', 'xmlns:v', 'xmlns:w10', 'xmlns:w', 'xmlns:sl'],
          ['urn:schemas-microsoft-com:office:office', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships',
          'http://schemas.microsoft.com/office/omml/2004/12/core', 'urn:schemas-microsoft-com:vml',
          'urn:schemas-microsoft-com:office:word', 'http://schemas.openxmlformats.org/wordprocessingml/2006/main',
          'http://schemas.openxmlformats.org/schemaLibrary/2006/2/main']);
          CreateFullNode('w:defaultTabStop', ['w:val'], ['708']);
          CreateFullNode('w:characterSpacingControl', ['w:val'], ['dontCompress']);
          CreateFullNode('w:compat');
          BeginNode('w:rsids');
            CreateFullNode('w:rsidRoot', ['w:val'], ['0072099D']);
            CreateFullNode('w:rsid', ['w:val'], ['0072099D']);
            CreateFullNode('w:rsid', ['w:val'], ['00E86975']);
          EndNode(); //w:rsids
          CreateFullNode('w:themeFontLang', ['w:val'], ['ru-RU']);
          CreateFullNode('w:clrSchemeMapping',
            ['w:bg1', 'w:t1', 'w:bg2', 'w:t2', 'w:accent1', 'w:accent2', 'w:accent3', 'w:accent4', 'w:accent5', 'w:accent6', 'w:hyperlink', 'w:followedHyperlink'],
            ['light1', 'dark1', 'light2', 'dark2', 'accent1', 'accent2', 'accent3', 'accent4', 'accent5', 'accent6', 'hyperlink', 'followedHyperlink']);
          BeginNode('w:shapeDefaults');
            CreateFullNode('o:shapedefaults', ['v:ext', 'spidmax'], ['edit', '2050']);
            BeginNode('o:shapelayout', ['v:ext'], ['edit']);
              CreateFullNode('o:idmap', ['v:ext', 'data'], ['edit', '1']);
            EndNode(); //o:shapelayout
          EndNode(); //w:shapeDefaults
        EndNode(); //w:settings
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\word\webSettings.xml'
  Stream := TFileStream.Create(FTempDir + '\word\webSettings.xml', fmCreate);
  try
    with TQXMLWriter.Create(Stream) do
      try
        CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
        BeginNode('w:webSettings', ['xmlns:r', 'xmlns:w'], ['http://schemas.openxmlformats.org/officeDocument/2006/relationships', 'http://schemas.openxmlformats.org/wordprocessingml/2006/main']);
          CreateFullNode('w:optimizeForBrowser');
          CreateFullNode('w:allowPNG');
        EndNode(); //w:webSettings
      finally
        Free;
      end;
  finally
    Stream.Free;
  end;

  //FTempDir + '\[Content_Types].xml'
  FContentStream := TFileStream.Create(FTempDir + '\[Content_Types].xml', fmCreate);
  FContentWriter := TQXMLWriter.Create(FContentStream);
  FContentWriter.CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
  FContentWriter.BeginNode('Types', ['xmlns'], ['http://schemas.openxmlformats.org/package/2006/content-types']);
end;

procedure TDocxFileMaker.FinishCommonData;
var
  IT: TQEImagePartType;
  S: WideString;
begin
  //FTempDir + '\word\_rels\document.xml.rels'
  FRelsWriter.EndNode(); //Relationships
  FreeAndNil(FRelsWriter);
  FreeAndNil(FRelsStream);

  //FTempDir + '\[Content_Types].xml'
  for IT := Low(TQEImagePartType) to High(TQEImagePartType) do
    if IT in FImageTypes then
    begin
      S := ImagePartTypeToExt(IT);
      if S <> '' then
        FContentWriter.CreateFullNode('Default', ['Extension', 'ContentType'], [S, 'image/' + S]);
    end;
  FContentWriter.CreateFullNode('Default', ['Extension', 'ContentType'], ['rels', 'application/vnd.openxmlformats-package.relationships+xml']);
  FContentWriter.CreateFullNode('Default', ['Extension', 'ContentType'], ['xml', 'application/xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/word/document.xml', 'application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/docProps/app.xml', 'application/vnd.openxmlformats-officedocument.extended-properties+xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/word/settings.xml', 'application/vnd.openxmlformats-officedocument.wordprocessingml.settings+xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/word/fontTable.xml', 'application/vnd.openxmlformats-officedocument.wordprocessingml.fontTable+xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/word/webSettings.xml', 'application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml']);
  FContentWriter.CreateFullNode('Override', ['PartName', 'ContentType'], ['/docProps/core.xml', 'application/vnd.openxmlformats-package.core-properties+xml']);
  FContentWriter.EndNode(); //Types
  FreeAndNil(FContentWriter);
  FreeAndNil(FContentStream);
end;

procedure TDocxFileMaker.CompressFile;
begin
  FZipper := TBaseArchiveClass.Create;
  try
    FZipper.TempDir := FTempDir;
    FZipper.FileName := ExportFileName;
    FZipper.Compress;
  finally
    FZipper.Free;
  end;
end;

procedure TDocxFileMaker.DefineAlignment(CellStyle: TDocxCellStyle);
begin
  if not Assigned(CellStyle) then
    Exit;
  with FExportWriter do
  begin
    case CellStyle.Alignment of
      caCenter: CreateFullNode('w:jc', ['w:val'], ['center']);
      caRight: CreateFullNode('w:jc', ['w:val'], ['right']);
      caJustify: CreateFullNode('w:jc', ['w:val'], ['both']);
    end;
  end;
end;

procedure TDocxFileMaker.DefineBackground(CellStyle: TDocxCellStyle);
begin
  if Assigned(CellStyle) and CellStyle.UseBackground and (CellStyle.BackgroundColor <> clWhite) then
    FExportWriter.CreateFullNode('w:shd', ['w:val', 'w:color', 'w:fill'],
      ['clear', 'auto', ColorToHex(CellStyle.BackgroundColor)]);
end;

procedure TDocxFileMaker.DefineBorder(Border: TDocxBorder);
begin
  if not Assigned(Border) then
    Exit;
  with FExportWriter do
  begin
    BeginNode('w:tcBorders');
      CreateFullNode('w:top', ['w:val', 'w:sz', 'w:space', 'w:color'],
        [MSBorderStyleToStr(Border.Style), '4', '0', ColorToHex(Border.Color)]);
      CreateFullNode('w:left', ['w:val', 'w:sz', 'w:space', 'w:color'],
        [MSBorderStyleToStr(Border.Style), '4', '0', ColorToHex(Border.Color)]);
      CreateFullNode('w:bottom', ['w:val', 'w:sz', 'w:space', 'w:color'],
        [MSBorderStyleToStr(Border.Style), '4', '0', ColorToHex(Border.Color)]);
      CreateFullNode('w:right', ['w:val', 'w:sz', 'w:space', 'w:color'],
        [MSBorderStyleToStr(Border.Style), '4', '0', ColorToHex(Border.Color)]);
    EndNode(false); //w:tcBorders
  end;
end;

procedure TDocxFileMaker.DefineFont(CellStyle: TDocxCellStyle);
begin
  if not Assigned(CellStyle) then
    Exit;
  with FExportWriter do
  begin
    BeginNode('w:rPr');
      if CellStyle.Font.Color <> clBlack then
        CreateFullNode('w:color', ['w:val'], [ColorToHex(CellStyle.Font.Color)]);
      if CellStyle.Font.Name <> 'Calibri' then
        CreateFullNode('w:rFonts', ['w:ascii', 'w:hAnsi', 'w:cs'],
          [CellStyle.Font.Name, CellStyle.Font.Name, CellStyle.Font.Name]);
      if CellStyle.Font.Size <> 11 then
      begin
        CreateFullNode('w:sz', ['w:val'], [IntToStr(CellStyle.Font.Size * 2)]);
        CreateFullNode('w:szCs', ['w:val'], [IntToStr(CellStyle.Font.Size * 2)]);
      end;
      if fsBold in CellStyle.Font.Style then
        CreateFullNode('w:b');
      if fsItalic in CellStyle.Font.Style then
        CreateFullNode('w:i');
      if fsUnderline in CellStyle.Font.Style then
        CreateFullNode('w:u', ['w:val'], ['single']);
      if fsStrikeOut in CellStyle.Font.Style then
        CreateFullNode('w:strike');
      if CellStyle.UseHighlight and (CellStyle.HighlightColor <> hcNone)  then
        CreateFullNode('w:highlight', ['w:val'], [MSHighlightColorToStr(CellStyle.HighlightColor)]);
      CreateFullNode('w:lang', ['w:val'], ['en-US']);
    EndNode(false); //w:rPr
  end;
end;

procedure TDocxFileMaker.PrepareExport;
begin
  FBlobCounter := 0;
  FImageTypes := [];
  FExportStream := TFileStream.Create(FTempDir + '\word\document.xml', fmCreate);
  FExportWriter := TQXMLWriter.Create(FExportStream);
  with FExportWriter do
  begin
    CreateProcessingInstruction('1.0', 'UTF-8', 'yes');
    BeginNode('w:document',
      ['xmlns:ve', 'xmlns:o', 'xmlns:o12', 'xmlns:r', 'xmlns:m', 'xmlns:v', 'xmlns:wp', 'xmlns:w10', 'xmlns:w'],
      ['http://schemas.openxmlformats.org/markup-compatibility/2006', 'urn:schemas-microsoft-com:office:office',
      'http://schemas.microsoft.com/office/2004/7/core', 'http://schemas.openxmlformats.org/officeDocument/2006/relationships',
      'http://schemas.microsoft.com/office/omml/2004/12/core', 'urn:schemas-microsoft-com:vml','http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing',
      'urn:schemas-microsoft-com:office:word', 'http://schemas.openxmlformats.org/wordprocessingml/2006/main']);
      BeginNode('w:body');
        BeginNode('w:tbl');

          BeginNode('w:tblPr');
            CreateFullNode('w:tblStyle', ['w:val'], ['TableGrid']);
            CreateFullNode('w:tblW', ['w:w', 'w:type'], ['0', 'auto']);
            CreateFullNode('w:tblLook', ['w:val'], ['04A0']);
          EndNode(false); //w:tblPr

  end;
end;

procedure TDocxFileMaker.FinishExport(const APageOrientation: TQExportPageOrientation);
begin
  //FTempDir + '\word\document.xml'
  with FExportWriter do
  begin
        EndNode(false); //w:tbl
        CreateFullNode('w:p');
        BeginNode('w:sectPr', ['w:rsidR', 'w:rsidSect'], ['00584319', '00584319']);
          if APageOrientation = poPortrait then
          begin
            CreateFullNode('w:pgSz', ['w:w', 'w:h'], ['11906', '16838']);
            CreateFullNode('w:pgMar', ['w:top', 'w:right', 'w:bottom', 'w:left', 'w:header', 'w:footer', 'w:gutter'],
              ['1134', '850', '1134', '1701', '708', '708', '0']);
          end else
          begin
            CreateFullNode('w:pgSz', ['w:w', 'w:h', 'w:orient'], ['16838', '11906', 'landscape']);
            CreateFullNode('w:pgMar', ['w:top', 'w:right', 'w:bottom', 'w:left', 'w:header', 'w:footer', 'w:gutter'],
              ['1701', '1134', '850 ', '1134', '708', '708', '0']);
          end;
          CreateFullNode('w:cols', ['w:space'], ['708']);
          CreateFullNode('w:docGrid', ['w:linePitch'], ['360']);
        EndNode(false); //w:sectPr
      EndNode(false); //w:body
    EndNode(false); //w:document
  end;
  FExportWriter.Free;
  FExportStream.Free;
end;

{ TQExport4Docx }

procedure TQExport4Docx.SetDocxOptions(const Value: TQExport4DocxOptions);
begin
  FDocxOptions.Assign(Value);
end;

procedure TQExport4Docx.WriteHeader;
var
  i: Integer;
begin
  if not FDocxFile.IsColumnsSectionReady then
    FDocxFile.IsColumnsSectionReady := True;
  for i := 0 to Header.Count - 1 do
  begin
    Inc(FCounter);
    FDocxFile.AddRow(FCounter, Header[i], DocxOptions.HeaderStyle)
  end;
end;

procedure TQExport4Docx.WriteFooter;
var
  i: Integer;
begin
  if not FDocxFile.IsColumnsSectionReady then
    FDocxFile.IsColumnsSectionReady := True;
  for i := 0 to Footer.Count - 1 do
  begin
    Inc(FCounter);
    FDocxFile.AddRow(FCounter, Footer[i], DocxOptions.FooterStyle);
  end;
end;

procedure TQExport4Docx.BeginExport;
begin
  inherited;
  FCounter := 0;
  FRowCounter := 0;
  FDocxFile := TDocxFileMaker.Create(Self, FileName);
  FDocxFile.ColumnsCount := ExportRow.Count;
  FDocxFile.CreateDirsStructure;
  if FDocxFile.IsExistDirsStructure then
  begin
    FDocxFile.PrepareCommonData;
    FDocxFile.PrepareExport;
    WriteHeader;
  end;
end;

procedure TQExport4Docx.BeforeExport;
begin
  inherited;

end;

procedure TQExport4Docx.AfterExport;
begin
  inherited;

end;

procedure TQExport4Docx.EndExport;
begin
  if FDocxFile.IsExistDirsStructure then
  begin
    WriteFooter;
    FDocxFile.FinishExport(DocxOptions.PageOrientation);
    FDocxFile.FinishCommonData;
    FDocxFile.CompressFile;
  end;
  FDocxFile.Free;
  inherited;
end;

constructor TQExport4Docx.Create(AOwner: TComponent);
begin
  inherited;
  FDocxOptions := TQExport4DocxOptions.Create(Self);
end;

destructor TQExport4Docx.Destroy;
begin
  FDocxOptions.Free;
  inherited;
end;

procedure TQExport4Docx.WriteCaptionRow;
begin
  if FDocxFile.IsExistDirsStructure then
  begin
    if not FDocxFile.IsColumnsSectionReady then
      FDocxFile.IsColumnsSectionReady := True;
    if DocxOptions.UseBorder then
      FDocxFile.AddRow(FCounter, Columns, DocxOptions.CaptionRowStyle, DocxOptions.Border)
    else
      FDocxFile.AddRow(FCounter, Columns, DocxOptions.CaptionRowStyle);
  end;
end;

procedure TQExport4Docx.WriteDataRow;
var
  n, i: Integer;
  Border: TDocxBorder;
begin
  if FDocxFile.IsExistDirsStructure then
  begin
    if not FDocxFile.IsColumnsSectionReady then
      FDocxFile.IsColumnsSectionReady := True;
    Inc(FCounter);
    if DocxOptions.UseBorder then
      Border := DocxOptions.Border
    else
      Border := nil;
    if (DocxOptions.StripStylesList.Count > 0) and (DocxOptions.StripStyleType <> ssNone) then
    begin
      if DocxOptions.StripStyleType = ssRow then
      begin
        n := FRowCounter mod DocxOptions.StripStylesList.Count;
        FDocxFile.AddRow(FCounter, ExportRow,
          DocxOptions.StripStylesList[n].Options, Border);
      end else // = ssColumn
      begin
        with FDocxFile.FExportWriter do
        begin
          BeginNode('w:tr', ['w:rsidR', 'w:rsidTr'], ['003E55F7', '003E55F7']);
          for i := 0 to ExportRow.Count - 1 do
          begin
            n := i mod DocxOptions.StripStylesList.Count;
            Formats.ApplyParams;
            FDocxFile.AddCell(ExportRow[i], DocxOptions.StripStylesList[n].Options, Border);
            Formats.RestoreSeparators;
          end;
          EndNode(false);
        end;
      end;
    end
    else begin
      Formats.ApplyParams;
      FDocxFile.AddRow(FCounter, ExportRow, DocxOptions.DataStyle, Border);
      Formats.RestoreSeparators;
    end;
    Inc(FRowCounter);
  end;
end;

procedure TQExport4Docx.Execute;
begin
  BeforeExecute;
  try
    DoExport;
    ShowResult;
  finally
    AfterExecute;
  end;
end;

procedure TQExport4Docx.FillExportCol(Index: Integer);
var
  DSField: TField;
  Graphic: TGraphic;
  Stream: TStream;
  IR: TImageRec;
  Data: Variant;
  P: Pointer;
begin
  if (Columns[Index].ColType = ectUnknown) then
  begin
    case ExportSource of
      esDataSet:
        DSField := DataSet.Fields[Columns[Index].Number];
      {$IFNDEF NOGUI}
      esDBGrid:
        DSField := DBGrid.Columns[Columns[Index].Number].Field;
      {$ENDIF}
    else
      DSField := nil;
    end;
    if (DSField is TBlobField) and not DSField.IsNull then
    begin
      Stream := DataSet.CreateBlobStream(DSField, bmRead);
      try
        IR.Data := DSField;
        Graphic := GetGraphicFromStream(Stream, IR.ImagePartType);
        if Assigned(Graphic) then
        begin
          IR.Height := Graphic.Height;
          IR.Width := Graphic.Width;
          Graphic.Free;
        end;
        Data := VarArrayCreate([0, SizeOf(IR)], varByte);
        P := VarArrayLock(Data);
        try
          Move(IR, P^, SizeOf(IR));
        finally
          VarArrayUnlock(Data);
        end;
        ExportRow.SetValue(Columns[Index].Name, '', Data);
        Exit;
      finally
        Stream.Free;
      end;
    end;
  end;
  inherited;
end;

end.
