qexport4ods.pas

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

  ODSFile.CloseWriter;
  ODSFile.CloseStream;
  ODSOptions.FontList.Clear;
  ODSFile.OpenStream('facefontstyles.xml');
  ODSFile.OpenWriter;
  for I := 1 to 4 do
    WriteFontStyleNode(I);
  for I := 0 to ODSOptions.StripStylesList.Count - 1 do
    WriteFontStyleNode(I + 5);
  ODSFile.WriteSpecificNode(1010, '', [], []);
  ODSFile.CloseWriter;
  ODSFile.CloseStream;
  //+-----------------------+
  //|Styles creation section|
  //+-----------------------+
  ODSFile.OpenStream('auto.xml');
  ODSFile.OpenWriter;
  ODSFile.WriteSpecificNode(11, '', [], []);
  for I := -3 to 4 do
    WriteCellStyleNode(I);
  for I := 0 to ODSOptions.StripStylesList.Count - 1 do
    WriteCellStyleNode(I + 5);
  ODSFile.WriteSpecificNode(1011, '', [], []);
  ODSFile.WriteSpecificNode(12, '', [], []);
  ODSFile.WriteSpecificNode(13, '', [], []);
  ODSFile.CloseWriter;
  ODSFile.CloseStream;
  ODSFile.OpenStream('autoStyles.xml');
  ODSFile.OpenWriter;
  ODSFile.WriteSpecificNode(27, '', [], []);
  for I := 0 to 4 do
    WriteCellStyleNode(I);
  for I := 0 to ODSOptions.StripStylesList.Count - 1 do
    WriteCellStyleNode(I + 5);
  ODSFile.WriteSpecificNode(1027, '', [], []);
  ODSFile.WriteSpecificNode(211, '', [], []);
  ODSFile.WriteSpecificNode(1028, '', [], []);
  ODSFile.CloseWriter;
  ODSFile.CloseStream;
end;

procedure TQExport4ODS.BeginExport;
var
  i: Integer;
  temp: WideString;
begin
  inherited;
  ODSFile.Renew;
  FRowCounter := 0;
  //ODS export
  ODSFile.TypeConvert := 1;
  ODSFile.FileName := Self.FileName;
  ODSFile.MakeAll;

  ODSFile.OpenStream('table.xml');
  ODSFile.OpenWriter;
  ODSFile.CheckStatus;
  ODSFile.WriteSpecificNode(15, '', ['table:name', 'table:style-name'],
    [SheetName, 'DefaultTableStyle']);
  for I := 0 to Columns.Count - 1 do
    ODSFile.WriteSpecificNode(19, '', ['table:style-name'], ['DefaultColumnStyle']);
  if (Header.Count > 0) then
  begin
    ODSFile.WriteSpecificNode(16, '', ['table:style-name'], ['DefaultRowStyle']);
    ODSFile.WriteSpecificNode(17, '', ['table:style-name', 'office:value-type'],
      ['Header', 'string']);
    for I := 0 to Header.Count - 1 do
    begin
      temp := Header[I];
      ODSFile.WriteSpecificNode(18, ReplaceSymbols(temp), [], []);
    end;
    ODSFile.WriteSpecificNode(1017, '', [], []);
    ODSFile.WriteSpecificNode(1016, '', [], []);
  end;
end;

function TQExport4ODS.ColorToString(Color: TColor): string;

  procedure SwapNums(Num1, Num2: Integer; var SwapStr: String);
  var
    a: char;
  begin
    a := SwapStr[Num1];
    SwapStr[Num1] := SwapStr[Num2];
    SwapStr[Num2] := a;
  end;

begin
  //Get Standard TColor representation
  FmtStr(Result, '%.6x', [Color]);
  //Swap 2 bytes to get defaul RGB representation
  SwapNums(1, 5, Result);
  SwapNums(2, 6, Result);
  Result := '#' + Result;
end;

constructor TQExport4ODS.Create(AOwner: TComponent);
begin
  inherited;
  ODSFile := TBaseODFFile.Create;
  FODSOptions := TQExportODSOptions.Create(Self);
  FTableName := {$IFDEF WIN32}QExportLoadStr(QED_ODS_StandardSheetName){$ENDIF}
     {$IFDEF LINUX}QED_ODS_StandardSheetName{$ENDIF};
end;

destructor TQExport4ODS.Destroy;
begin
  ODSFile.Free;
  FODSOptions.Free;
  inherited;
end;

procedure TQExport4ODS.EndExport;
var
  I: integer;
  temp: WideString;
begin
  if (Footer.Count > 0) then
  begin
    ODSFile.WriteSpecificNode(16, '', ['table:style-name'], ['DefaultRowStyle']);
    ODSFile.WriteSpecificNode(17, '', ['table:style-name', 'office:value-type'],
      ['Footer', 'string']);
    for I := 0 to Footer.Count - 1 do
    begin
      temp := Footer[I];
      ODSFile.WriteSpecificNode(18, ReplaceSymbols(temp), [], []);
    end;
    ODSFile.WriteSpecificNode(1017, '', [], []);
    ODSFile.WriteSpecificNode(1016, '', [], []);
  end;
  ODSFile.WriteSpecificNode(1015, '', [], []);
  ODSFile.CloseWriter;
  ODSFile.CloseStream;
  ODSFile.EndFormingContent;
  AddStyles;
  ODSFile.MergeContent('content.xml', ['first.xml', 'facefont.xml', 'auto.xml',
    'table.xml', 'last.xml' ]);
  ODSFile.MergeContent('styles.xml', ['firstSt.xml', 'facefontstyles.xml',
    'autoStyles.xml']);
  ODSFile.DeleteList(['first.xml', 'facefont.xml', 'auto.xml',
    'table.xml', 'last.xml', 'firstSt.xml', 'facefontstyles.xml',
    'autoStyles.xml']);
  ODSFile.Compress;
  inherited;
end;

procedure TQExport4ODS.Execute;
begin
  if SheetName = '' then
    raise Exception.Create('Sheet name is not defined');
  DoExport;
  ShowResult;
end;


function TQExport4ODS.PointsToCms(Value: Integer): string;
var
  TempString: string;
  Idx: Integer;
begin
  if Value = 0 then
  begin
    Result := '0cm';
    Exit;
  end;
  TempString := FloatToStr(Value * 0.0352);
  Idx := QEPos(',', TempString);
  TempString[Idx] := '.';
  Result := Copy(TempString, 1, 5);
  Result := Result + 'cm';
end;

procedure TQExport4ODS.SetOptions(const Value: TQExportODSOptions);
begin
  FODSOptions.Assign(Value);
end;

procedure TQExport4ODS.WriteCaptionRow;
var
  I: Integer;
  aaa: WideString;
begin
  ODSFile.WriteSpecificNode(16, '', ['table:style-name'], ['DefaultRowStyle']);
  for i := 0 to Columns.Count - 1 do
  begin
    ODSFile.WriteSpecificNode(17, '', ['table:style-name', 'office:value-type'],
      ['CaptionRow', 'string']);
    aaa := GetColCaption(i);
    ODSFile.WriteSpecificNode(18, ReplaceSymbols(aaa), [], []);
    ODSFile.WriteSpecificNode(1018, '', [], []);
    ODSFile.WriteSpecificNode(1017, '', [], []);
  end;
  ODSFile.WriteSpecificNode(1016, '', [], []);
end;

procedure TQExport4ODS.WriteDataRow;
var
  I, Num: Integer;
  CurrValue: WideString;
begin
  Inc(FRowCounter);
  ODSFile.WriteSpecificNode(16, '', ['table:style-name'], ['DefaultRowStyle']);
  for I := 0 to ExportRow.Count - 1 do
  begin
    Formats.ApplyParams;
    CurrValue := GetExportedValue(ExportRow[I]);
    Formats.RestoreSeparators;
    if (ODSOptions.StripStyle = sstNone) then
      ODSFile.WriteSpecificNode(17, '', ['office:value-type', 'table:style-name'],
        ['string', 'DataStyle'])
    else
    begin
      //Column-style
      if (ODSOptions.StripStyle = sstColumn) then
      begin
        Num := (I + 1) mod ODSOptions.StripStylesList.Count;
        if (Num = 0) then
          Num := ODSOptions.StripStylesList.Count;
        ODSFile.WriteSpecificNode(17, '', ['office:value-type', 'table:style-name'],
          ['string', 'StripStyle' + IntToStr(Num)]);
      end;
      //Row-style
      if (ODSOptions.StripStyle = sstRow) then
      begin
        Num := FRowCounter mod ODSOptions.StripStylesList.Count;
        if (Num = 0) then
          Num := ODSOptions.StripStylesList.Count;
        ODSFile.WriteSpecificNode(17, '', ['office:value-type', 'table:style-name'],
          ['string', 'StripStyle' + IntToStr(Num)]);
      end;
    end;
    ODSFile.WriteSpecificNode(18, ReplaceSymbols(CurrValue), [], []);
    ODSFile.WriteSpecificNode(1018, '', [], []);
    ODSFile.WriteSpecificNode(1017, '', [], []);
  end;
  ODSFile.WriteSpecificNode(1016, '', [], []);
end;

{ TQExportODSOptions }

procedure TQExportODSOptions.Assign(Source: TPersistent);
begin
  if Source is TQExportODSOptions then begin
    HeaderStyle := (Source as TQExportODSOptions).HeaderStyle;
    FooterStyle := (Source as TQExportODSOptions).FooterStyle;
    CaptionRowStyle := (Source as TQExportODSOptions).CaptionRowStyle;
    StripStylesList := (Source as TQExportODSOptions).StripStylesList;
    DataStyle := (Source as TQExportODSOptions).DataStyle;
    StripStyle := (Source as TQExportODSOptions).StripStyle;
    Exit;
  end;
  inherited;
end;

function TQExportODSOptions.CheckFontInList(FontName: string): Boolean;
var
  I: Integer;
begin
  Result := false;
  for I := 0 to FontList.Count - 1 do
    if (FontName = FontList[I]) then
    begin
      Result := true;
      Exit;
    end;
end;

constructor TQExportODSOptions.Create(Holder: TPersistent);
begin
  inherited Create;
  FHolder := Holder;
  FHeaderStyle := TODSCellParagraphStyle.Create(nil);
  FFooterStyle := TODSCellParagraphStyle.Create(nil);
  FCaptionRowStyle := TODSCellParagraphStyle.Create(nil);
  FDataStyle := TODSCellParagraphStyle.Create(nil);
  FStripStyle := sstNone;
  FStripStylesList := TODSStylesList.Create(Self);
  FFontList := TStringList.Create;
end;

destructor TQExportODSOptions.Destroy;
begin
  FHeaderStyle.Free;
  FFooterStyle.Free;
  FCaptionRowStyle.Free;
  FDataStyle.Free;
  FStripStylesList.Free;
  FFontList.Free;
  inherited;
end;

function TQExportODSOptions.GetOwner: TPersistent;
begin
  Result := FHolder;
end;

procedure TQExportODSOptions.SetCaptionStyle(const Value: TODSCellParagraphStyle);
begin
  FCaptionRowStyle.Assign(Value);
end;

procedure TQExportODSOptions.SetDataStyle(const Value: TODSCellParagraphStyle);
begin
  FDataStyle.Assign(Value);
end;

procedure TQExportODSOptions.SetFooterStyle(const Value: TODSCellParagraphStyle);
begin
  FFooterStyle.Assign(Value);
end;

procedure TQExportODSOptions.SetHeaderStyle(const Value: TODSCellParagraphStyle);
begin
  FHeaderStyle.Assign(Value);
end;


procedure TQExportODSOptions.SetStripStyles(const Value: TODSStylesList);
begin
  FStripStylesList.Assign(Value);
end;

end.