qexport4odt.pas

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

unit QExport4ODT;

{$I VerCtrl.inc}

interface

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

type
  TQExportODTOptions = class(TPersistent)
  private
    FHolder: TPersistent;
    FHeaderStyle: TODTParagraphStyle;
    FFooterStyle: TODTParagraphStyle;
    FCaptionRowStyle: TODTCellParagraphStyle;
    FDataStyle: TODTCellParagraphStyle;
    FStripStyle: TODFStripStyleType;
    FStripStylesList: TODTStylesList;
    FFontList: TStrings;
    FBorder: TODFBorder;

    procedure SetHeaderStyle(const Value: TODTParagraphStyle);
    procedure SetFooterStyle(const Value: TODTParagraphStyle);
    procedure SetCaptionStyle(const Value: TODTCellParagraphStyle);
    procedure SetDataStyle(const Value: TODTCellParagraphStyle);
    procedure SetStripStyles(const Value: TODTStylesList);
  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: TODTParagraphStyle read FHeaderStyle
      write SetHeaderStyle;
    property FooterStyle: TODTParagraphStyle read FFooterStyle
      write SetFooterStyle;
    property CaptionRowStyle: TODTCellParagraphStyle read FCaptionRowStyle
      write SetCaptionStyle;
    property DataStyle: TODTCellParagraphStyle read FDataStyle write SetDataStyle;
    property StripStyle: TODFStripStyleType read FStripStyle write FStripStyle
      default sstNone;
    property StripStylesList: TODTStylesList read FStripStylesList
      write SetStripStyles;
    property Border: TODFBorder read FBorder write FBorder;
  end;

  TQExport4ODT = class(TQExport4FormatText)
  private
    FODTFile: TBaseODFFile;
    FTableName: String;
    FODTOptions: TQExportODTOptions;
    FRowCounter: Integer;
    FBufferRow: array of WideString;
    function ColorToString(Color: TColor): string;
    function PointsToCms(Value: Integer): string;
    procedure SetOptions(const Value: TQExportODTOptions);
  protected
    procedure BeginExport; override;
    procedure EndExport; override;
    procedure AfterExport; override;

    procedure WriteDataRow; override;
    procedure WriteCaptionRow; override;
    procedure WriteBufferedRow(TypeOfRow: Integer);
    procedure ClearBufferedRow;
    procedure AddStyles;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Execute; override;
    property ODTFile: TBaseODFFile read FODTFile write FODTFile;
  published
    property TableName: String read FTableName write FTableName;
    property ODTOptions: TQExportODTOptions read FODTOptions write SetOptions;
  end;

implementation

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


{ TQExport4ODT }

procedure TQExport4ODT.AddStyles;
var
  I: Integer;

  procedure WriteFontStyleNode(TypeOfOptions: Integer);

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

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

  procedure WriteCellStyleNode(TypeOfOptions: Integer; Prefix: WideString);

    procedure SubRoutine(TempPar: TODTCellParagraphStyle; Name: WideString);
    var
      AttList, AttValues: array of WideString;
      Num: integer;
    begin
      //Common style declaring section
      ODTFile.WriteSpecificNode(21, '', ['style:name','style:family'],
        [Name, 'table-cell']);
      SetLength(AttList, 6);
      SetLength(AttValues, 6);
      AttList[0] := 'fo:padding';
      AttValues[0] := '0.035cm';
      if (ODTOptions.Border.BorderStyle = bsODFSolid) then
      begin
        AttList[1] := 'fo:border-top';
        AttValues[1] := PointsToCms(ODTOptions.Border.BorderWidth) +
          ' ' + 'solid' + ' ' + ColorToString(ODTOptions.Border.BorderColor);
        AttList[2] := 'fo:border-left';
        AttValues[2] := PointsToCms(ODTOptions.Border.BorderWidth) +
          ' ' + 'solid' + ' ' + ColorToString(ODTOptions.Border.BorderColor);
        if QEPos('Layer', Name) <> 0 then
        begin
          AttList[4] := 'fo:border-bottom';
          AttValues[4] := PointsToCms(ODTOptions.Border.BorderWidth) +
                            ' ' + 'solid' + ' ' +
                              ColorToString(ODTOptions.Border.BorderColor);
        end
        else
        begin
          AttList[4] := 'fo:border-bottom';
          AttValues[4] := 'none';
        end;
        if QEPos('Ender', Name) <> 0 then
        begin
          AttList[5] := 'fo:border-right';
          AttValues[5] := PointsToCms(ODTOptions.Border.BorderWidth) +
                            ' ' + 'solid' + ' ' +
                              ColorToString(ODTOptions.Border.BorderColor);
        end
        else
        begin
          AttList[5] := 'fo:border-right';
          AttValues[5] := 'none';
        end;
      end
      else
      begin
        AttList[1] := 'fo:border-top';
        AttValues[1] := 'none';
        AttList[2] := 'fo:border-left';
        AttValues[2] := 'none';
        AttList[4] := 'fo:border-bottom';
        AttValues[4] := 'none';
        AttList[5] := 'fo:border-right';
        AttValues[5] := 'none';
      end;
      case TempPar.VerticalAligment of
        taODFTop: begin
                    AttList[3] := 'style:vertical-align';
                    AttValues[3] := 'top';
                  end;
        taODFMiddle: begin
                       AttList[3] := 'style:vertical-align';
                       AttValues[3] := 'middle';
                     end;
        taODFBottom: begin
                       AttList[3] := 'style:vertical-align';
                       AttValues[3] := 'bottom';
                     end;
      end;
      if (TempPar.AllowBackground) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 1);
        SetLength(AttValues, Num + 1);
        AttList[Num] := 'fo:background-color';
        AttValues[Num] := ColorToString(TempPar.BackgroundColor);
      end;
      ODTFile.WriteSpecificNode(25, '', AttList, AttValues);
      ODTFile.WriteSpecificNode(1021, '', [], []);
    end;
  begin
    //for CaptionRow
    if (TypeOfOptions = 1) then
      SubRoutine(ODTOptions.CaptionRowStyle, Prefix + 'CaptionCellRow');
    //For DataRow
    if (TypeOfOptions = 2) then
      SubRoutine(ODTOptions.DataStyle, Prefix + 'DataCellStyle');
    //for stripes styles
    if (TypeOfOptions > 2) then
      SubRoutine(ODTOptions.StripStylesList[TypeOfOptions - 3],
        Prefix + 'StripCellStyle' + IntToStr(TypeOfOptions - 2));
  end;

  procedure WriteParagraphStyleNode(TypeOfOptions: Integer);

    procedure SubRoutine(TempPar: TODTParagraphStyle; Name: WideString);
    var
      AttList, AttValues: array of WideString;
      Num: integer;
    begin
      SetLength(AttList, 3);
      SetLength(AttValues, 3);
      AttList[0] := 'style:family';
      AttValues[0] := 'paragraph';
      AttList[1] := 'style:parent-style-name';
      AttValues[1] := 'Standard';
      AttList[2] := 'style:name';
      AttValues[2] := Name;
      ODTFile.WriteSpecificNode(21, '', AttList, AttValues);
      AttList[0] := 'style:font-name';
      AttValues[0] := TempPar.Font.Name;
      AttList[1] := 'fo:font-size';
      AttValues[1] := IntToStr(TempPar.Font.Size) + 'pt';
      AttList[2] := 'fo:color';
      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;
      if (TempPar.AllowHighlight) then
      begin
        Num := Length(AttValues);
        SetLength(AttList, Num + 1);
        SetLength(AttValues, Num + 1);
        AttList[Num] := 'fo:background-color';
        AttValues[Num] := ColorToString(TempPar.HighlightColor);
      end;
      ODTFile.WriteSpecificNode(26, '', AttList, AttValues);
      SetLength(AttList, 1);
      SetLength(AttValues, 1);
      case TempPar.Alignment of
        taODFLeft:
          begin
            AttList[0] := 'fo:text-align';
            AttValues[0] := 'start';
          end;
        taODFRight:
          begin
            AttList[0] := 'fo:text-align';
            AttValues[0] := 'end';
          end;
        taODFCenter:
          begin
            AttList[0] := 'fo:text-align';
            AttValues[0] := 'center';
          end;
        taODFJustify:
          begin
            AttList[0] := 'fo:text-align';
            AttValues[0] := 'justify';
          end;
      end;
      if (TempPar.AllowBackground) then
      begin
        SetLength(AttList, 2);
        SetLength(AttValues, 2);
        AttList[1] := 'fo:background-color';
        AttValues[1] := ColorToString(TempPar.BackgroundColor);
      end;
      ODTFile.WriteSpecificNode(29, '', AttList, AttValues);