qexport4xlsx.pas

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

function TXlsxCellStyle.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)
    and (FVerticalAligment = cvaBottom)
    and (not FWrapText);
end;

procedure TXlsxCellStyle.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;
    FVerticalAligment := cvaBottom;
    FWrapText := False;
  end;
end;

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

procedure TXlsxCellStyle.SetBorder(const Value: TXlsxBorder);
begin
  FBorder.Assign(Value);
end;

constructor TXlsxCellStyle.Create;
begin
  FFont := TFont.Create;
  FBorder := TXlsxBorder.Create;
  Default;
end;

destructor TXlsxCellStyle.Destroy;
begin
  FBorder.Free;
  FFont.Free;
  inherited;
end;

procedure TXlsxCellStyle.Assign(Source: TPersistent);
begin
  if Source is TXlsxCellStyle then
  begin
    Font := TXlsxCellStyle(Source).Font;
    UseBackground := TXlsxCellStyle(Source).UseBackground;
    BackgroundColor := TXlsxCellStyle(Source).BackgroundColor;
    Alignment := TXlsxCellStyle(Source).Alignment;
    VerticalAligment := TXlsxCellStyle(Source).VerticalAligment;
    WrapText := TXlsxCellStyle(Source).WrapText;
    UseBorder := TXlsxCellStyle(Source).UseBorder;
    Border.Assign(TXlsxCellStyle(Source).Border);
  end;
end;

procedure TXlsxCellStyle.LoadFromIni(IniFile: TQIniFile;
  const Section: WideString);
begin
  with IniFile do
  begin
    Font.Name := ReadString(Section, S_XLSX_FontName, 'Calibri');
    Font.Size := ReadInteger(Section, S_XLSX_FontSize, 11);
    Font.Color := ReadInteger(Section, S_XLSX_FontColor, clBlack);
    if ReadBool(Section, S_XLSX_FontBold, False) then
      Font.Style := Font.Style + [fsBold]
    else
      Font.Style := Font.Style - [fsBold];
    if ReadBool(Section, S_XLSX_FontItalic, False) then
      Font.Style := Font.Style + [fsItalic]
    else
      Font.Style := Font.Style - [fsItalic];
    if ReadBool(Section, S_XLSX_FontUnderline, False) then
      Font.Style := Font.Style + [fsUnderline]
    else
      Font.Style := Font.Style - [fsUnderline];
    UseBackground := ReadBool(Section, S_XLSX_UseBackground, False);
    BackgroundColor := ReadInteger(Section, S_XLSX_BackgroundColor, clBlack);
    Alignment := TMSCellAlignment(ReadInteger(Section, S_XLSX_HorAlignment, 0));
    VerticalAligment := TMSCellVerticalAligment(ReadInteger(Section, S_XLSX_VertAlignment, 0));
    UseBorder := ReadBool(Section, S_XLSX_UseBorder, False);
    Border.Style := TXlsxBorderStyle(ReadInteger(Section, S_XLSX_BorderStyle, 0));
    Border.Color := ReadInteger(Section, S_XLSX_BorderColor, clBlack);
  end;
end;

procedure TXlsxCellStyle.SaveToIni(IniFile: TQIniFile;
  const Section: WideString);
begin
  with IniFile do
  begin
    WriteString(Section, S_XLSX_FontName, Font.Name);
    WriteInteger(Section, S_XLSX_FontSize, Font.Size);
    WriteInteger(Section, S_XLSX_FontColor, Font.Color);
    if fsBold in Font.Style then
      WriteBool(Section, S_XLSX_FontBold, true)
    else
      WriteBool(Section, S_XLSX_FontBold, false);
    if fsItalic in Font.Style then
      WriteBool(Section, S_XLSX_FontItalic, true)
    else
      WriteBool(Section, S_XLSX_FontItalic, false);
    if fsUnderline in Font.Style then
      WriteBool(Section, S_XLSX_FontUnderline, true)
    else
      WriteBool(Section, S_XLSX_FontUnderline, false);
    WriteBool(Section, S_XLSX_UseBackground, UseBackground);
    WriteInteger(Section, S_XLSX_BackgroundColor, BackgroundColor);
    WriteInteger(Section, S_XLSX_HorAlignment, Integer(Alignment));
    WriteInteger(Section, S_XLSX_VertAlignment, Integer(VerticalAligment));
    WriteBool(Section, S_XLSX_UseBorder, UseBorder);
    WriteInteger(Section, S_XLSX_BorderStyle, Integer(Border.Style));
    WriteInteger(Section, S_XLSX_BorderColor, Border.Color);
  end;
end;

procedure TXlsxCellStyle.Default;
begin
  FFont.Name := 'Calibri';
  FFont.Size := 11;
  FFont.Style := [];
  FFont.Color := clBlack;
  FBackgroundColor := clWhite;
  FUseBackground := False;
  FAlignment := caLeft;
  FVerticalAligment := cvaBottom;
  FWrapText := False;
  FUseBorder := False;
  FBorder.Default;
end;

{ TQExport4XlsxOptions }

procedure TQExport4XlsxOptions.SetHeaderStyle(const Value: TXlsxCellStyle);
begin
  FHeaderStyle.Assign(Value);
end;

procedure TQExport4XlsxOptions.SetCaptionStyle(
  const Value: TXlsxCellStyle);
begin
  FCaptionRowStyle.Assign(Value);
end;

procedure TQExport4XlsxOptions.SetDataStyle(const Value: TXlsxCellStyle);
begin
  FDataStyle.Assign(Value);
end;

procedure TQExport4XlsxOptions.SetStripStyles(
  const Value: TXlsxStripStyleList);
begin
  FStripStylesList.Assign(Value);
end;

procedure TQExport4XlsxOptions.SetFooterStyle(const Value: TXlsxCellStyle);
begin
  FFooterStyle.Assign(Value);
end;

constructor TQExport4XlsxOptions.Create(Holder: TPersistent);
begin
  inherited Create;
  FHolder := Holder;
  FHeaderStyle := TXlsxCellStyle.Create;
  FCaptionRowStyle := TXlsxCellStyle.Create;
  FDataStyle := TXlsxCellStyle.Create;
  FStripStyle := ssNone;
  FStripStylesList := TXlsxStripStyleList.Create(TXlsxStripStyle);
  FFooterStyle := TXlsxCellStyle.Create;
end;

destructor TQExport4XlsxOptions.Destroy;
begin
  FHolder := nil;
  FHeaderStyle.Free;
  FCaptionRowStyle.Free;
  FDataStyle.Free;
  FStripStylesList.Free;
  FFooterStyle.Free;
  inherited;
end;

procedure TQExport4XlsxOptions.Assign(Source: TPersistent);
begin
  if Source is TQExport4XlsxOptions then
  begin
    HeaderStyle := TQExport4XlsxOptions(Source).HeaderStyle;
    CaptionRowStyle := TQExport4XlsxOptions(Source).CaptionRowStyle;
    DataStyle := TQExport4XlsxOptions(Source).DataStyle;
    StripStyleType := TQExport4XlsxOptions(Source).StripStyleType;
    StripStylesList := TQExport4XlsxOptions(Source).StripStylesList;
    FooterStyle := TQExport4XlsxOptions(Source).FooterStyle;
  end;
end;

{ TXlsxMaker }

constructor TXlsxFileMaker.Create(const ExportFile: WideString;
  ExportOptions: TQExport4XlsxOptions);
begin
  FSharedList := {$IFDEF QE_UNICODE}TWideStringList.Create{$ELSE}TStringList.Create{$ENDIF};
  FExportFileName := ExportFile;
  FTempDir := ExtractFileDir(ParamStr(0)) + '\Temp';
  FSheetName := 'sheet1';
  if Assigned(ExportOptions) then
    FXlsxOptions := ExportOptions;
end;

destructor TXlsxFileMaker.Destroy;
begin
  if Assigned(FXlsxOptions) then
    FXlsxOptions := nil;
  FSharedList.Free;
  inherited;
end;

function TXlsxFileMaker.GetSharedString(Value: WideString): Integer;
begin
//  Inc(FSharedCount);
//  Result := FSharedCount;
//  with FSharedWriter do
//  begin
//    BeginNode('si', '', [], []);
//    CreateFullNode('t', Value, [], []);
//    EndNode('si');
//  end;
  FSharedList.Add(Value);
  Result := FSharedList.Count - 1;
end;

procedure TXlsxFileMaker.SetSheetName(const Value: WideString);
begin
  if Value <> '' then
    FSheetName := Value;
end;

procedure TXlsxFileMaker.CreateDirsStructure;
begin
  ForceDirectories(FTempDir);
  ForceDirectories(FTempDir + '\xl');
  ForceDirectories(FTempDir + '\xl\_rels');
  ForceDirectories(FTempDir + '\xl\theme');
  ForceDirectories(FTempDir + '\xl\worksheets');
  ForceDirectories(FTempDir + '\docProps');
  ForceDirectories(FTempDir + '\_rels');
end;

function TXlsxFileMaker.IsExistDirsStructure: Boolean;
begin
  Result := DirectoryExists(FTempDir)
    and DirectoryExists(FTempDir + '\xl')
    and DirectoryExists(FTempDir + '\xl\_rels')
    and DirectoryExists(FTempDir + '\xl\theme')
    and DirectoryExists(FTempDir + '\xl\worksheets')
    and DirectoryExists(FTempDir + '\docProps')
    and DirectoryExists(FTempDir + '\_rels');
end;

procedure TXlsxFileMaker.FillCommonData;
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', 'xl/workbook.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('Application', 'Microsoft Excel', [], []);
        CreateFullNode('DocSecurity', '0', [], []);
        CreateFullNode('ScaleCrop', 'false', [], []);
        BeginNode('HeadingPairs', '', [], []);
        BeginNode('vt:vector', '', ['size', 'baseType'], ['2', 'variant']);
        BeginNode('vt:variant', '', [], []);
        CreateFullNode('vt:lpstr', 'Worksheets', [], []);
        EndNode('vt:variant');
        BeginNode('vt:variant', '', [], []);
        CreateFullNode('vt:i4', '1', [], []); 
        EndNode('vt:variant');
        EndNode('vt:vector');
        EndNode('HeadingPairs');
        BeginNode('TitlesOfParts', '', [], []);
        BeginNode('vt:vector', '', ['size', 'baseType'], ['1', 'lpstr']);
        CreateFullNode('vt:lpstr', FSheetName, [], []);
        EndNode('vt:vector');
        EndNode('TitlesOfParts');
        CreateFullNode('Company', '', [], []);   
        CreateFullNode('LinksUpToDate', 'false', [], []);
        CreateFullNode('SharedDoc', 'false', [], []);
        CreateFullNode('HyperlinksChanged', 'false', [], []);
        CreateFullNode('AppVersion', '12.0000', [], []);
        EndNode('Properties');
      finally
        Free;