pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Significantly improve speed of the ooxml writer, by rvk (see discussion in http://forum.lazarus.freepascal.org/index.php/topic,25110.0.html)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3305 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-10 15:55:40 +00:00
parent de36e9419b
commit ddd6902edf
3 changed files with 303 additions and 193 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
components/fpspreadsheet/fpsutils.pas
View File

@ -34,6 +34,8 @@ type
} }
TFormatDateTimeOptions = set of TFormatDateTimeOption; TFormatDateTimeOptions = set of TFormatDateTimeOption;
TsStreamClass = class of TStream;
const const
{@@ Date formatting string for unambiguous date/time display as strings {@@ Date formatting string for unambiguous date/time display as strings
Can be used for text output when date/time cell support is not available } Can be used for text output when date/time cell support is not available }
@ -130,6 +132,12 @@ function UTF8TextToXMLText(AText: ansistring): ansistring;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String; function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
function PosInMemory(AMagic: QWord; ABuffer: PByteArray; ABufSize: Integer): Integer;
procedure Unused(const A1); procedure Unused(const A1);
procedure Unused(const A1, A2); procedure Unused(const A1, A2);
procedure Unused(const A1, A2, A3); procedure Unused(const A1, A2, A3);
@ -1932,6 +1940,48 @@ begin
RemoveChars(0, coEqual); RemoveChars(0, coEqual);
end; end;
procedure AppendToStream(AStream: TStream; const AString: string);
begin
if Length(AString) > 0 then
AStream.WriteBuffer(AString[1], Length(AString));
end;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String);
begin
AppendToStream(AStream, AString1);
AppendToStream(AStream, AString2);
end;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String);
begin
AppendToStream(AStream, AString1);
AppendToStream(AStream, AString2);
AppendToStream(AStream, AString3);
end;
function PosInMemory(AMagic: QWord; ABuffer: PByteArray; ABufSize: Integer): Integer;
var
i, j: Integer;
MagicBytes: Array[0..7] of byte absolute AMagic;
found: Boolean;
begin
Result := -1;
for i:=0 to ABufSize - SizeOf(QWord) do begin
if (ABuffer^[i] = MagicBytes[0]) then begin
found := true;
for j:=1 to 7 do
if ABuffer^[i+j] <> MagicBytes[j] then begin
found := false;
break;
end;
if found then begin
Result := i;
exit;
end;
end;
end;
end;
{$PUSH}{$HINTS OFF} {$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter } {@@ Silence warnings due to an unused parameter }
procedure Unused(const A1); procedure Unused(const A1);

4
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -92,6 +92,7 @@
<Unit4> <Unit4>
<Filename Value="manualtests.pas"/> <Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="testsutility.pas"/> <Filename Value="testsutility.pas"/>
@ -100,10 +101,12 @@
<Unit6> <Unit6>
<Filename Value="internaltests.pas"/> <Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="formattests.pas"/> <Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="colortests.pas"/> <Filename Value="colortests.pas"/>
@ -134,6 +137,7 @@
<Unit14> <Unit14>
<Filename Value="emptycelltests.pas"/> <Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14> </Unit14>
</Units> </Units>
</ProjectOptions> </ProjectOptions>

442
components/fpspreadsheet/xlsxooxml.pas
View File

@ -60,29 +60,30 @@ type
TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) TsSpreadOOXMLWriter = class(TsCustomSpreadWriter)
protected protected
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
{ Strings with the contents of files }
FContentTypes: string;
FRelsRels: string;
FWorkbookString, FWorkbookRelsString, FStylesString, FSharedStrings: string;
FSheets: array of string;
FSharedStringsCount: Integer; FSharedStringsCount: Integer;
protected protected
{ Helper routines } { Helper routines }
procedure CreateNumFormatList; override; procedure CreateNumFormatList; override;
procedure CreateStreams;
procedure DestroyStreams;
function GetStyleIndex(ACell: PCell): Cardinal;
protected protected
{ Streams with the contents of files } { Streams with the contents of files }
FSContentTypes: TStringStream; FStreamClass: TsStreamClass;
FSRelsRels: TStringStream; FSContentTypes: TStream;
FSWorkbook, FSWorkbookRels, FSStyles, FSSharedStrings: TStringStream; FSRelsRels: TStream;
FSSheets: array of TStringStream; FSWorkbook: TStream;
FSWorkbookRels: TStream;
FSStyles: TStream;
FSSharedStrings: TStream;
FSSharedStrings_complete: TStream;
FSSheets: array of TStream;
FCurSheetNum: Integer; FCurSheetNum: Integer;
protected protected
{ Routines to write those files } { Routines to write the files }
procedure WriteGlobalFiles; procedure WriteGlobalFiles;
procedure WriteContent; procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet); procedure WriteWorksheet(CurSheet: TsWorksheet);
function GetStyleIndex(ACell: PCell): Cardinal;
protected protected
{ Record writing methods } { Record writing methods }
//todo: add WriteDate //todo: add WriteDate
@ -92,7 +93,6 @@ type
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General writing methods } { General writing methods }
procedure WriteStringToFile(AFileName, AString: string); procedure WriteStringToFile(AFileName, AString: string);
procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override; procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override;
@ -147,131 +147,164 @@ procedure TsSpreadOOXMLWriter.WriteGlobalFiles;
var var
i: Integer; i: Integer;
begin begin
// WriteCellsToStream(AStream, AData.GetFirstWorksheet.FCells); { --- Content Types --- }
AppendToStream(FSContentTypes,
XML_HEADER);
AppendToStream(FSContentTypes,
'<Types xmlns="' + SCHEMAS_TYPES + '">');
AppendToStream(FSContentTypes,
'<Override PartName="/_rels/.rels" ContentType="' + MIME_RELS + '" />');
AppendToStream(FSContentTypes,
'<Override PartName="/xl/_rels/workbook.xml.rels" ContentType="application/vnd.openxmlformats-package.relationships+xml" />');
AppendToStream(FSContentTypes,
'<Override PartName="/xl/workbook.xml" ContentType="' + MIME_SHEET + '" />');
FContentTypes := for i:=1 to Workbook.GetWorksheetCount do
XML_HEADER + LineEnding + AppendToStream(FSContentTypes, Format(
'<Types xmlns="' + SCHEMAS_TYPES + '">' + LineEnding + '<Override PartName="/xl/worksheets/sheet%d.xml" ContentType="%s" />',
// ' <Default Extension="xml" ContentType="' + MIME_XML + '" />' + LineEnding + [i, MIME_WORKSHEET]));
// ' <Default Extension="rels" ContentType="' + MIME_RELS + '" />' + LineEnding +
' <Override PartName="/_rels/.rels" ContentType="' + MIME_RELS + '" />' + LineEnding +
// <Override PartName="/docProps/core.xml" ContentType="application/vnd.openxmlformats-package.core-properties+xml"/>
// <Override PartName="/docProps/app.xml" ContentType="application/vnd.openxmlformats-officedocument.extended-properties+xml"/>
' <Override PartName="/xl/_rels/workbook.xml.rels" ContentType="application/vnd.openxmlformats-package.relationships+xml" />' + LineEnding +
' <Override PartName="/xl/workbook.xml" ContentType="' + MIME_SHEET + '" />' + LineEnding;
for i := 1 to Workbook.GetWorksheetCount do
begin
FContentTypes := FContentTypes +
Format(' <Override PartName="/xl/worksheets/sheet%d.xml" ContentType="%s" />', [i, MIME_WORKSHEET]) + LineEnding;
end;
FContentTypes := FContentTypes +
' <Override PartName="/xl/styles.xml" ContentType="' + MIME_STYLES + '" />' + LineEnding +
' <Override PartName="/xl/sharedStrings.xml" ContentType="' + MIME_STRINGS + '" />' + LineEnding +
'</Types>';
FRelsRels := AppendToStream(FSContentTypes,
XML_HEADER + LineEnding + '<Override PartName="/xl/styles.xml" ContentType="' + MIME_STYLES + '" />');
'<Relationships xmlns="' + SCHEMAS_RELS + '">' + LineEnding + AppendToStream(FSContentTypes,
'<Relationship Type="' + SCHEMAS_DOCUMENT + '" Target="xl/workbook.xml" Id="rId1" />' + LineEnding + '<Override PartName="/xl/sharedStrings.xml" ContentType="' + MIME_STRINGS + '" />');
'</Relationships>'; AppendToStream(FSContentTypes,
'</Types>');
FStylesString := { --- RelsRels --- }
XML_HEADER + LineEnding + AppendToStream(FSRelsRels,
'<styleSheet xmlns="' + SCHEMAS_SPREADML + '">' + LineEnding + XML_HEADER);
' <fonts count="2">' + LineEnding + AppendToStream(FSRelsRels, Format(
' <font><sz val="10" /><name val="Arial" /></font>' + LineEnding + '<Relationships xmlns="%s">', [SCHEMAS_RELS]));
' <font><sz val="10" /><name val="Arial" /><b val="true"/></font>' + LineEnding + AppendToStream(FSRelsRels, Format(
' </fonts>' + LineEnding + '<Relationship Type="%s" Target="xl/workbook.xml" Id="rId1" />', [SCHEMAS_DOCUMENT]));
' <fills count="2">' + LineEnding + AppendToStream(FSRelsRels,
' <fill>' + LineEnding + '</Relationships>');
' <patternFill patternType="none" />' + LineEnding +
' </fill>' + LineEnding + { --- Styles --- }
' <fill>' + LineEnding + AppendToStream(FSStyles,
' <patternFill patternType="gray125" />' + LineEnding + XML_Header);
' </fill>' + LineEnding + AppendToStream(FSStyles, Format(
' </fills>' + LineEnding + '<styleSheet xmlns="%s">', [SCHEMAS_SPREADML]));
' <borders count="1">' + LineEnding + AppendToStream(FSStyles,
' <border>' + LineEnding + '<fonts count="2">');
' <left />' + LineEnding + AppendToStream(FSStyles,
' <right />' + LineEnding + '<font><sz val="10" /><name val="Arial" /></font>',
' <top />' + LineEnding + '<font><sz val="10" /><name val="Arial" /><b val="true"/></font>');
' <bottom />' + LineEnding + AppendToStream(FSStyles,
' <diagonal />' + LineEnding + '</fonts>');
' </border>' + LineEnding + AppendToStream(FSStyles,
' </borders>' + LineEnding + '<fills count="2">');
' <cellStyleXfs count="2">' + LineEnding + AppendToStream(FSStyles,
' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" />' + LineEnding + '<fill>',
' <xf numFmtId="0" fontId="1" fillId="0" borderId="0" />' + LineEnding + '<patternFill patternType="none" />',
' </cellStyleXfs>' + LineEnding + '</fill>');
' <cellXfs count="2">' + LineEnding + AppendToStream(FSStyles,
' <xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />' + LineEnding + '<fill>',
' <xf numFmtId="0" fontId="1" fillId="0" borderId="0" xfId="0" />' + LineEnding + '<patternFill patternType="gray125" />',
' </cellXfs>' + LineEnding + '</fill>');
' <cellStyles count="1">' + LineEnding + AppendToStream(FSStyles,
' <cellStyle name="Normal" xfId="0" builtinId="0" />' + LineEnding + '</fills>');
' </cellStyles>' + LineEnding + AppendToStream(FSStyles,
' <dxfs count="0" />' + LineEnding + '<borders count="1">');
' <tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />' + LineEnding + AppendToStream(FSStyles,
'</styleSheet>'; '<border>',
'<left /><right /><top /><bottom /><diagonal />',
'</border>');
AppendToStream(FSStyles,
'</borders>');
AppendToStream(FSStyles,
'<cellStyleXfs count="2">');
AppendToStream(FSStyles,
'<xf numFmtId="0" fontId="0" fillId="0" borderId="0" />',
'<xf numFmtId="0" fontId="1" fillId="0" borderId="0" />');
AppendToStream(FSStyles,
'</cellStyleXfs>');
AppendToStream(FSStyles,
'<cellXfs count="2">');
AppendToStream(FSStyles,
'<xf numFmtId="0" fontId="0" fillId="0" borderId="0" xfId="0" />',
'<xf numFmtId="0" fontId="1" fillId="0" borderId="0" xfId="0" />');
AppendToStream(FSStyles,
'</cellXfs>');
AppendToStream(FSStyles,
'<cellStyles count="1">',
'<cellStyle name="Normal" xfId="0" builtinId="0" />',
'</cellStyles>');
AppendToStream(FSStyles,
'<dxfs count="0" />');
AppendToStream(FSStyles,
'<tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />');
AppendToStream(FSStyles,
'</styleSheet>');
end; end;
procedure TsSpreadOOXMLWriter.WriteContent; procedure TsSpreadOOXMLWriter.WriteContent;
var var
i: Integer; i: Integer;
begin begin
{ --- WorkbookRels ---
{ Workbook relations - Mark relation to all sheets } { Workbook relations - Mark relation to all sheets }
FWorkbookRelsString := AppendToStream(FSWorkbookRels,
XML_HEADER + LineEnding + XML_HEADER);
'<Relationships xmlns="' + SCHEMAS_RELS + '">' + LineEnding + AppendToStream(FSWorkbookRels,
'<Relationship Id="rId1" Type="' + SCHEMAS_STYLES + '" Target="styles.xml" />' + LineEnding + '<Relationships xmlns="' + SCHEMAS_RELS + '">');
'<Relationship Id="rId2" Type="' + SCHEMAS_STRINGS + '" Target="sharedStrings.xml" />' + LineEnding; AppendToStream(FSWorkbookRels,
'<Relationship Id="rId1" Type="' + SCHEMAS_STYLES + '" Target="styles.xml" />');
AppendToStream(FSWorkbookRels,
'<Relationship Id="rId2" Type="' + SCHEMAS_STRINGS + '" Target="sharedStrings.xml" />');
for i := 1 to Workbook.GetWorksheetCount do for i:=1 to Workbook.GetWorksheetCount do
begin AppendToStream(FSWorkbookRels, Format(
FWorkbookRelsString := FWorkbookRelsString + '<Relationship Type="%s" Target="worksheets/sheet%d.xml" Id="rId%d" />',
Format('<Relationship Type="%s" Target="worksheets/sheet%d.xml" Id="rId%d" />', [SCHEMAS_WORKSHEET, i, i+2]) + LineEnding; [SCHEMAS_WORKSHEET, i, i+2]));
end;
FWorkbookRelsString := FWorkbookRelsString + AppendToStream(FSWOrkbookRels,
'</Relationships>'; '</Relationships>');
// Global workbook data - Mark all sheets { --- Workbook --- }
FWorkbookString := { Global workbook data - Mark all sheets }
XML_HEADER + LineEnding + AppendToStream(FSWorkbook,
'<workbook xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding + XML_HEADER);
' <fileVersion appName="fpspreadsheet" />' + LineEnding + // lastEdited="4" lowestEdited="4" rupBuild="4505" AppendToStream(FSWorkbook, Format(
' <workbookPr defaultThemeVersion="124226" />' + LineEnding + '<workbook xmlns="%s" xmlns:r="%s">', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS]));
' <bookViews>' + LineEnding + AppendToStream(FSWorkbook,
' <workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />' + LineEnding + '<fileVersion appName="fpspreadsheet" />');
' </bookViews>' + LineEnding; AppendToStream(FSWorkbook,
'<workbookPr defaultThemeVersion="124226" />');
AppendToStream(FSWorkbook,
'<bookViews>',
'<workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />',
'</bookViews>');
AppendToStream(FSWorkbook,
'<sheets>');
for i:=1 to Workbook.GetWorksheetCount do
AppendToStream(FSWorkbook, Format(
'<sheet name="Sheet%d" sheetId="%d" r:id="rId%d" />', [i, i, i+2]));
AppendToStream(FSWorkbook,
'</sheets>');
AppendToStream(FSWorkbook,
'<calcPr calcId="114210" />');
AppendToStream(FSWorkbook,
'</workbook>');
FWorkbookString := FWorkbookString + ' <sheets>' + LineEnding; // Preparation for shared strings
for i := 1 to Workbook.GetWorksheetCount do
FWorkbookString := FWorkbookString +
Format(' <sheet name="Sheet%d" sheetId="%d" r:id="rId%d" />', [i, i, i+2]) + LineEnding;
FWorkbookString := FWorkbookString + ' </sheets>' + LineEnding;
FWorkbookString := FWorkbookString +
' <calcPr calcId="114210" />' + LineEnding +
'</workbook>';
// Preparation for Shared strings
FSharedStringsCount := 0; FSharedStringsCount := 0;
FSharedStrings := '';
// Write all worksheets, which fills also FSharedStrings
SetLength(FSheets, 0);
// Write all worksheets which fills also the shared strings
for i := 0 to Workbook.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
WriteWorksheet(Workbook.GetWorksheetByIndex(i)); WriteWorksheet(Workbook.GetWorksheetByIndex(i));
// Finalization of the shared strings document // Finalization of the shared strings document
FSharedStrings := AppendToStream(FSSharedStrings_complete,
XML_HEADER + LineEnding + XML_HEADER, Format(
'<sst xmlns="' + SCHEMAS_SPREADML + '" count="' + IntToStr(FSharedStringsCount) + '<sst xmlns="%s" count="%d" uniqueCount="%d">', [SCHEMAS_SPREADML, FSharedStringsCount, FSharedStringsCount]
'" uniqueCount="' + IntToStr(FSharedStringsCount) + '">' + LineEnding + ));
FSharedStrings + FSSharedStrings.Position := 0;
'</sst>'; FSSharedStrings_complete.CopyFrom(FSSharedStrings, FSSharedStrings.Size);
AppendToStream(FSSharedStrings_complete,
'</sst>');
FSSharedStrings_complete.Position := 0;
end; end;
{ {
@ -315,58 +348,63 @@ FSheets[CurStr] :=
} }
procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet); procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet);
var var
j, k: Integer; r, c: Cardinal;
LastColIndex: Cardinal; LastColIndex: Cardinal;
LCell: TCell; LCell: TCell;
AVLNode: TAVLTreeNode; AVLNode: TAVLTreeNode;
CellPosText: string; CellPosText: string;
// S: String;
begin begin
FCurSheetNum := Length(FSheets); FCurSheetNum := Length(FSSheets);
SetLength(FSheets, FCurSheetNum + 1); SetLength(FSSheets, FCurSheetNum + 1);
LastColIndex := CurSheet.GetLastColIndex; FSSheets[FCurSheetNum] := FStreamClass.Create; // create the stream
// Header // Header
FSheets[FCurSheetNum] := AppendToStream(FSSheets[FCurSheetNum],
XML_HEADER + LineEnding + XML_HEADER);
'<worksheet xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding + AppendToStream(FSSheets[FCurSheetNum], Format(
' <sheetViews>' + LineEnding + '<worksheet xmlns="%s" xmlns:r="%s">', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS]));
' <sheetView workbookViewId="0" />' + LineEnding + AppendToStream(FSSheets[FCurSheetNum],
' </sheetViews>' + LineEnding + '<sheetViews>');
' <sheetData>' + LineEnding; AppendToStream(FSSheets[FCurSheetNum],
'<sheetView workbookViewId="0" />');
AppendToStream(FSSheets[FCurSheetNum],
'</sheetViews>');
AppendToStream(FSSheets[FCurSheetNum],
'<sheetData>');
// The cells need to be written in order, row by row, cell by cell // The cells need to be written in order, row by row, cell by cell
for j := 0 to CurSheet.GetLastRowIndex do LastColIndex := CurSheet.GetLastColIndex;
begin for r := 0 to CurSheet.GetLastRowIndex do begin
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum], Format(
Format(' <row r="%d" spans="1:%d">', [j+1,LastColIndex+1]) + LineEnding; '<row r="%d" spans="1:%d">', [r+1, LastColIndex+1]));
// Write cells belonging to this row.
// Write cells from this row. for c := 0 to LastColIndex do
for k := 0 to LastColIndex do
begin begin
LCell.Row := j; LCell.Row := r;
LCell.Col := k; LCell.Col := c;
AVLNode := CurSheet.Cells.Find(@LCell); AVLNode := CurSheet.Cells.Find(@LCell);
if Assigned(AVLNode) then if Assigned(AVLNode) then
WriteCellCallback(PCell(AVLNode.Data), nil) WriteCellCallback(PCell(AVLNode.Data), nil)
else else
begin begin
CellPosText := CurSheet.CellPosToText(j, k); CellPosText := CurSheet.CellPosToText(r, c);
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum], Format(
Format(' <c r="%s">', [CellPosText]) + LineEnding + '<c r="%s">', [CellPosText]),
' <v></v>' + LineEnding + '<v></v>',
' </c>' + LineEnding; '</c>');
end; end;
end; end;
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum],
' </row>' + LineEnding; '</row>');
end; end;
// Footer // Footer
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum],
' </sheetData>' + LineEnding + '</sheetData>',
'</worksheet>'; '</worksheet>');
end; end;
// This is an index to the section cellXfs from the styles.xml file // This is an index to the section cellXfs from the styles.xml file
@ -379,25 +417,52 @@ end;
constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook); constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create(AWorkbook); inherited Create(AWorkbook);
FStreamClass := TMemoryStream;
FPointSeparatorSettings := DefaultFormatSettings; FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.'; FPointSeparatorSettings.DecimalSeparator := '.';
end; end;
destructor TsSpreadOOXMLWriter.Destroy;
begin
SetLength(FSheets, 0);
SetLength(FSSheets, 0);
inherited Destroy;
end;
procedure TsSpreadOOXMLWriter.CreateNumFormatList; procedure TsSpreadOOXMLWriter.CreateNumFormatList;
begin begin
FreeAndNil(FNumFormatList); FreeAndNil(FNumFormatList);
FNumFormatList := TsOOXMLNumFormatList.Create(Workbook); FNumFormatList := TsOOXMLNumFormatList.Create(Workbook);
end; end;
{ Creates the streams for the individual data files. Will be zipped into a
single xlsx file.
We use the variable FStreamClass here to be able to easily switch from a
memory stream to a file stream for very big files. }
procedure TsSpreadOOXMLWriter.CreateStreams;
begin
FSContentTypes := FStreamClass.Create;
FSRelsRels := FStreamClass.Create;
FSWorkbookRels := FStreamClass.Create;
FSWorkbook := FStreamClass.Create;
FSStyles := FStreamClass.Create;
FSSharedStrings := FStreamClass.Create;
FSSharedStrings_complete := FStreamClass.Create;
// FSSheets will be created when needed.
end;
{ Destroys the streams that were created by the writer }
procedure TsSpreadOOXMLWriter.DestroyStreams;
var
i: Integer;
begin
FSContentTypes.Free;
FSRelsRels.Free;
FSWorkbookRels.Free;
FSWorkbook.Free;
FSStyles.Free;
FSSharedStrings.Free;
FSSharedStrings_complete.Free;
for i := 0 to Length(FSSheets) - 1 do
FSSheets[i].Free;
SetLength(FSSheets, 0);
end;
{ {
Writes a string to a file. Helper convenience method. Writes a string to a file. Helper convenience method.
} }
@ -438,27 +503,14 @@ var
FZip: TZipper; FZip: TZipper;
i: Integer; i: Integer;
begin begin
{ Fill the strings with the contents of the files } { Create the streams that will hold the file contents }
CreateStreams;
{ Fill the streams with the contents of the files }
WriteGlobalFiles; WriteGlobalFiles;
WriteContent; WriteContent;
{ Write the data to streams }
FSContentTypes := TStringStream.Create(FContentTypes);
FSRelsRels := TStringStream.Create(FRelsRels);
FSWorkbookRels := TStringStream.Create(FWorkbookRelsString);
FSWorkbook := TStringStream.Create(FWorkbookString);
FSStyles := TStringStream.Create(FStylesString);
FSSharedStrings := TStringStream.Create(FSharedStrings);
SetLength(FSSheets, Length(FSheets));
for i := 0 to Length(FSheets) - 1 do
FSSheets[i] := TStringStream.Create(FSheets[i]);
{ Now compress the files } { Now compress the files }
FZip := TZipper.Create; FZip := TZipper.Create;
try try
FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES); FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES);
@ -466,23 +518,25 @@ begin
FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS); FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS);
FZip.Entries.AddFileEntry(FSWorkbook, OOXML_PATH_XL_WORKBOOK); FZip.Entries.AddFileEntry(FSWorkbook, OOXML_PATH_XL_WORKBOOK);
FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES); FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES);
FZip.Entries.AddFileEntry(FSSharedStrings, OOXML_PATH_XL_STRINGS); FZip.Entries.AddFileEntry(FSSharedStrings_complete, OOXML_PATH_XL_STRINGS);
for i := 0 to Length(FSheets) - 1 do for i := 0 to Length(FSSheets) - 1 do begin
FSSheets[i].Position:= 0;
FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + 'sheet' + IntToStr(i + 1) + '.xml'); FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + 'sheet' + IntToStr(i + 1) + '.xml');
end;
// Stream position must be at beginning, it was moved to end during adding of xml strings.
FSContentTypes.Position := 0;
FSRelsRels.Position := 0;
FSWorkbookRels.Position := 0;
FSWorkbook.Position := 0;
FSStyles.Position := 0;
FSSharedStrings_complete.Position := 0;
FZip.SaveToStream(AStream); FZip.SaveToStream(AStream);
finally finally
FSContentTypes.Free; DestroyStreams;
FSRelsRels.Free;
FSWorkbookRels.Free;
FSWorkbook.Free;
FSStyles.Free;
FSSharedStrings.Free;
for i := 0 to Length(FSSheets) - 1 do
FSSheets[i].Free;
FZip.Free; FZip.Free;
end; end;
end; end;
@ -505,6 +559,7 @@ var
lStyleIndex: Cardinal; lStyleIndex: Cardinal;
TextTooLong: boolean=false; TextTooLong: boolean=false;
ResultingValue: string; ResultingValue: string;
//S: string;
begin begin
Unused(AStream); Unused(AStream);
Unused(ARow, ACol, ACell); Unused(ARow, ACol, ACell);
@ -518,17 +573,17 @@ begin
else else
ResultingValue:=AValue; ResultingValue:=AValue;
FSharedStrings := FSharedStrings + AppendToStream(FSSharedStrings,
' <si>' + LineEnding + '<si>', Format(
Format(' <t>%s</t>', [UTF8TextToXMLText(ResultingValue)]) + LineEnding + '<t>%s</t>', [UTF8TextToXMLText(ResultingValue)]),
' </si>' + LineEnding; '</si>' );
CellPosText := TsWorksheet.CellPosToText(ARow, ACol); CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell); lStyleIndex := GetStyleIndex(ACell);
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum], Format(
Format(' <c r="%s" s="%d" t="s"><v>%d</v></c>', [CellPosText, lStyleIndex, FSharedStringsCount]) + LineEnding; '<c r="%s" s="%d" t="s"><v>%d</v></c>', [CellPosText, lStyleIndex, FSharedStringsCount]));
Inc(FSharedStringsCount); Inc(FSharedStringsCount);
{ {
//todo: keep a log of errors and show with an exception after writing file or something. //todo: keep a log of errors and show with an exception after writing file or something.
We can't just do the following We can't just do the following
@ -547,12 +602,13 @@ procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow,
var var
CellPosText: String; CellPosText: String;
CellValueText: String; CellValueText: String;
//S: String;
begin begin
Unused(AStream, ACell); Unused(AStream, ACell);
CellPosText := TsWorksheet.CellPosToText(ARow, ACol); CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
CellValueText := Format('%g', [AValue], FPointSeparatorSettings); CellValueText := Format('%g', [AValue], FPointSeparatorSettings);
FSheets[FCurSheetNum] := FSheets[FCurSheetNum] + AppendToStream(FSSheets[FCurSheetNum], Format(
Format(' <c r="%s" s="0" t="n"><v>%s</v></c>', [CellPosText, CellValueText]) + LineEnding; '<c r="%s" s="0" t="n"><v>%s</v></c>', [CellPosText, CellValueText]));
end; end;
{******************************************************************* {*******************************************************************