qexport4ods.pas

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

unit QExport4ODS;

{$I VerCtrl.inc}

interface

uses Classes, QExport4, QExport4IniFiles, BaseODFClass4, QExport4Types
  {$IFDEF WIN32}
    {$IFNDEF NOGUI}, Graphics{$ELSE}, QExport4Graphics{$ENDIF}
  {$ENDIF}
  {$IFDEF LINUX}
    {$IFNDEF NOGUI}, QGraphics{$ELSE}, QExport4Graphics{$ENDIF}
  {$ENDIF};

type
  TQExportODSOptions = class(TPersistent)
  private
    FHolder: TPersistent;
    FHeaderStyle: TODSCellParagraphStyle;
    FFooterStyle: TODSCellParagraphStyle;
    FCaptionRowStyle: TODSCellParagraphStyle;
    FDataStyle: TODSCellParagraphStyle;
    FStripStyle: TODFStripStyleType;
    FStripStylesList: TODSStylesList;
    FFontList: TStrings;

    procedure SetHeaderStyle(const Value: TODSCellParagraphStyle);
    procedure SetFooterStyle(const Value: TODSCellParagraphStyle);
    procedure SetCaptionStyle(const Value: TODSCellParagraphStyle);
    procedure SetDataStyle(const Value: TODSCellParagraphStyle);
    procedure SetStripStyles(const Value: TODSStylesList);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(Holder: TPersistent);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CheckFontInList(FontName: string): Boolean;

    property FontList: TStrings read FFontList write FFontList;
  published
    property HeaderStyle: TODSCellParagraphStyle read FHeaderStyle
      write SetHeaderStyle;
    property FooterStyle: TODSCellParagraphStyle read FFooterStyle
      write SetFooterStyle;
    property CaptionRowStyle: TODSCellParagraphStyle read FCaptionRowStyle
      write SetCaptionStyle;
    property DataStyle: TODSCellParagraphStyle read FDataStyle
      write SetDataStyle;
    property StripStyle: TODFStripStyleType read FStripStyle write FStripStyle
      default sstNone;
    property StripStylesList: TODSStylesList read FStripStylesList
      write SetStripStyles;
  end;

  TQExport4ODS = class(TQExport4FormatText)
  private
    FODSFile: TBaseODFFile;
    FTableName: String;
    FODSOptions: TQExportODSOptions;
    FRowCounter: Integer;
    function ColorToString(Color: TColor): string;
    function PointsToCms(Value: Integer): string;
    procedure SetOptions(const Value: TQExportODSOptions);
  protected
    procedure BeginExport; override;

    procedure EndExport; override;
    procedure WriteDataRow; override;
    procedure WriteCaptionRow; override;
    procedure AddStyles;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Execute; override;
    property ODSFile: TBaseODFFile read FODSFile write FODSFile;

  published
    property SheetName: String read FTableName write FTableName;
    property ODSOptions: TQExportODSOptions read FODSOptions write SetOptions;
  end;

implementation

uses {$IFDEF WIN32}QExport4StrIDs{$ENDIF}
     {$IFDEF LINUX}QExport4Consts{$ENDIF},
     SysUtils, QExport4Common, QExport4EmsWideStrUtils;


{ TQExport4ODS }

procedure TQExport4ODS.AddStyles;
var
  I: Integer;

  procedure WriteFontStyleNode(TypeOfOptions: Integer);

    procedure SubRoutine(TempPar: TODSCellParagraphStyle);
    begin
      ODSFile.WriteSpecificNode(20, '', ['style:name', 'svg:font-family',
        'style:font-pitch'], [TempPar.Font.Name, TempPar.Font.Name, 'variable']);
      ODSOptions.FontList.Add(TempPar.Font.Name);
    end;

  begin
    if (TypeOfOptions = 0) then
      if not (ODSOptions.CheckFontInList('Arial')) then
      begin
        ODSFile.WriteSpecificNode(20, '', ['style:name', 'svg:font-family',
          'style:font-pitch'], ['Arial', 'Arial', 'variable']);
        ODSOptions.FontList.Add('Arial');
      end;
    if (TypeOfOptions = 1) then
      if not (ODSOptions.CheckFontInList(ODSOptions.HeaderStyle.Font.Name)) then
        SubRoutine(ODSOptions.HeaderStyle);
    if (TypeOfOptions = 2) then
      if not (ODSOptions.CheckFontInList(ODSOptions.FooterStyle.Font.Name)) then
        SubRoutine(ODSOptions.FooterStyle);
    if (TypeOfOptions = 3) then
      if not (ODSOptions.CheckFontInList(ODSOptions.CaptionRowStyle.Font.Name)) then
        SubRoutine(ODSOptions.CaptionRowStyle);
    if (TypeOfOptions = 4) then
      if not (ODSOptions.CheckFontInList(ODSOptions.DataStyle.Font.Name)) then
        SubRoutine(ODSOptions.DataStyle);
    if (TypeOfOptions > 4) then
      if not (ODSOptions.CheckFontInList(
        ODSOptions.StripStylesList[TypeOfOptions - 5].Font.Name)) then
          SubRoutine(ODSOptions.StripStylesList[TypeOfOptions - 5]);
  end;

  procedure WriteCellStyleNode(TypeOfOptions: Integer);

    procedure SubRoutine(TempPar: TODSCellParagraphStyle; Name: WideString;
      Border: TODFBorder);
    var
      AttList, AttValues: array of WideString;
      Num: integer;
    begin
      //Common style declaring section
      ODSFile.WriteSpecificNode(21, '', ['style:name',
        'style:family', 'style:parent-style-name'], [Name, 'table-cell', 'Default']);
      SetLength(AttList, 3);
      SetLength(AttValues, 3);
      AttList[0] := 'style:font-name';
      AttList[1] := 'fo:font-size';
      AttList[2] := 'fo:color';
      AttValues[0] := TempPar.Font.Name;
      AttValues[1] := IntToStr(TempPar.Font.Size) + 'pt';
      AttValues[2] := ColorToString(TempPar.Font.Color);
      if (fsItalic in TempPar.Font.Style) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 1);
        SetLength(AttValues, Num + 1);
        AttList[Num] := 'fo:font-style';
        AttValues[Num] := 'italic';
      end;
      if (fsBold in TempPar.Font.Style) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 1);
        SetLength(AttValues, Num + 1);
        AttList[Num] := 'fo:font-weight';
        AttValues[Num] := 'bold';
      end;
      if (fsUnderline in TempPar.Font.Style) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 3);
        SetLength(AttValues, Num + 3);
        AttList[Num] := 'style:text-underline-style';
        AttValues[Num] := 'solid';
        AttList[Num + 1] := 'text-underline-width';
        AttValues[Num + 1] := 'auto';
        AttList[Num + 2] :='style:text-underline-color';
        AttValues[Num + 2] := 'font-color';
      end;
      if (fsStrikeOut in TempPar.Font.Style) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 1);
        SetLength(AttValues, Num + 1);
        AttList[Num] := 'style:text-line-through-style';
        AttValues[Num] := 'solid';
      end;
      ODSFile.WriteSpecificNode(26, '', AttList, AttValues);

      case TempPar.Alignment of
        taODFLeft:
          ODSFile.WriteSpecificNode(29, '', ['fo:text-align'], ['start']);
        taODFRight:
          ODSFile.WriteSpecificNode(29, '', ['fo:text-align'], ['end']);
        taODFCenter:
          ODSFile.WriteSpecificNode(29, '', ['fo:text-align'], ['center']);
        taODFJustify:
          ODSFile.WriteSpecificNode(29, '', ['fo:text-align'], ['justify']);
      end;

      SetLength(AttList, 4);
      SetLength(AttValues, 4);
      AttList[0] := 'style:text-align-source';
      AttList[1] := 'style:repeat-content';
      AttValues[0] := 'fix';
      AttValues[1] := 'false';
      AttList[2] := 'fo:border';
      AttList[3] := 'style:vertical-align';
      if (Border.BorderStyle = bsODFSolid) then
        AttValues[2] := PointsToCms(Border.BorderWidth) +
            ' ' + 'solid' + ' ' + ColorToString(Border.BorderColor)
      else
        AttValues[2] := 'none';
      case TempPar.VerticalAligment of
        taODFTop:
          AttValues[3] := 'top';
        taODFMiddle:
          AttValues[3] := 'middle';
        taODFBottom:
          AttValues[3] := 'bottom';
      end;
      if (TempPar.AllowBackground) then
      begin
        SetLength(AttList, 5);
        SetLength(AttValues, 5);
        AttList[4] := 'fo:background-color';
        AttValues[4] := ColorToString(TempPar.BackgroundColor);
      end;
      ODSFile.WriteSpecificNode(25, '', AttList, AttValues);
      ODSFile.WriteSpecificNode(1021, '', [], []);
    end;
  begin
    //Default Table Style
    if (TypeOfOptions = -3) then
    begin
      ODSFile.WriteSpecificNode(21, '', ['style:name', 'style:family'],
        ['DefaultTableStyle', 'table']);
      ODSFile.WriteSpecificNode(22, '', ['table:display', 'style:writing-mode'],
        ['true', 'lr-tb']);
      ODSFile.WriteSpecificNode(1021, '', [], []);
      Exit;
    end;
    //Default Column Style
    if (TypeOfOptions = -1) then
    begin
      ODSFile.WriteSpecificNode(21, '', ['style:name', 'style:family'],
        ['DefaultColumnStyle', 'table-column']);
      ODSFile.WriteSpecificNode(23, '', [], []);
      ODSFile.WriteSpecificNode(1021, '', [], []);
      Exit;
    end;
    //Default Row Style
    if (TypeOfOptions = -2) then
    begin
      ODSFile.WriteSpecificNode(21, '', ['style:name', 'style:family'],
        ['DefaultRowStyle', 'table-row']);
      ODSFile.WriteSpecificNode(24, '', [], []);
      ODSFile.WriteSpecificNode(1021, '', [], []);
      Exit;
    end;
    //Default Cell style
    if (TypeOfOptions = 0) then
    begin
      ODSFile.WriteSpecificNode(21, '', ['style:name', 'style:family',
        'style:parent-style-name'], ['DefaultCell', 'table-cell', 'Default']);
      ODSFile.WriteSpecificNode(26, '', ['style:font-name', 'fo:font-size',
        'fo:color'], ['Arial', '10pt', '#000000']);
      ODSFile.WriteSpecificNode(29, '', ['fo:text-align'], ['start']);
      ODSFile.WriteSpecificNode(25, '', ['fo:background-color',
        'style:text-align-source', 'style:repeat-content', 'style:vertical-align'],
        ['#FFFFFF', 'fix', 'false', 'bottom']);
      ODSFile.WriteSpecificNode(1021, '', [], []);
      Exit;
    end;
    //Style for header
    if (TypeOfOptions = 1) then
    begin
      SubRoutine(ODSOptions.HeaderStyle, 'Header', ODSOptions.HeaderStyle.Border);
      Exit;
    end;
    //Style for footer
    if (TypeOfOptions = 2) then
    begin
      SubRoutine(ODSOptions.FooterStyle, 'Footer', ODSOptions.FooterStyle.Border);
      Exit;
    end;
    //Style for caption row
    if (TypeOfOptions = 3) then
    begin
      SubRoutine(ODSOptions.CaptionRowStyle, 'CaptionRow',
        ODSOptions.CaptionRowStyle.Border);
      Exit;
    end;
    //Style for DataStyle
    if (TypeOfOptions = 4) then
    begin
      SubRoutine(ODSOptions.DataStyle, 'DataStyle', ODSOptions.DataStyle.Border);
      Exit;
    end;

    //Style for StripStyles
    if (TypeOfOptions > 4) then
    begin
      SubRoutine(ODSOptions.StripStylesList[TypeOfOptions - 5],
        'StripStyle' + IntToStr(TypeOfOptions - 4),
          ODSOptions.StripStylesList[TypeOfOptions - 5].StripBorder);
      Exit;
    end;
  end;

begin
  //+-------------------------------------+
  //|Default face-fonts processing section|
  //+-------------------------------------+
  ODSFile.OpenStream('facefont.xml');
  ODSFile.OpenWriter;
  for I := 1 to 4 do
  begin
    WriteFontStyleNode(I);
  end;
  for I := 0 to ODSOptions.StripStylesList.Count - 1 do
  begin
    WriteFontStyleNode(I + 5);
  end;
  ODSFile.WriteSpecificNode(1010, '', [], []);