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

fpspreadsheet: Reformat xlsxml.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4345 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-20 15:25:05 +00:00
parent 9f593aa10a
commit 0ce72db2f0
1 changed files with 122 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files

220
components/fpspreadsheet/xlsxml.pas
View File

@ -1,3 +1,17 @@
{@@ ----------------------------------------------------------------------------
Unit: xlsxml
implements a reader and writer for the SpreadsheetXML format.
This document was introduced by Microsoft for Excel XP and 2003.
REFERENCE: https://msdn.microsoft.com/en-us/library/aa140066%28v=office.15%29.aspx
AUTHOR : Werner Pamler
LICENSE : See the file COPYING.modifiedLGPL.txt, included in the Lazarus
distribution, for details about the license.
-------------------------------------------------------------------------------}
unit xlsxml; unit xlsxml;
{$ifdef fpc} {$ifdef fpc}
@ -70,7 +84,18 @@ uses
fpsStrings, fpsUtils, fpsStreams, fpsNumFormat, fpsHTMLUtils; fpsStrings, fpsUtils, fpsStreams, fpsNumFormat, fpsHTMLUtils;
const const
FMT_OFFSET = 61; FMT_OFFSET = 61;
INDENT1 = ' ';
INDENT2 = ' ';
INDENT3 = ' ';
INDENT4 = ' ';
INDENT5 = ' ';
VALUE_INDENT = INDENT5;
CELL_INDENT = INDENT4;
ROW_INDENT = INDENT3;
COL_INDENT = INDENT3;
TABLE_INDENT = INDENT2;
LF = LineEnding;
const const
{ TsFillStyle = ( { TsFillStyle = (
@ -150,7 +175,7 @@ begin
Result := ''; Result := '';
comment := FWorksheet.FindComment(ACell); comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then if Assigned(comment) then
Result := '<Comment><Data>' + comment^.Text + '</Data></Comment>'; Result := INDENT1 + '<Comment><Data>' + comment^.Text + '</Data></Comment>' + LF + CELL_INDENT;
// If there will be some rich-text-like formatting in the future, use // If there will be some rich-text-like formatting in the future, use
// Result := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>': // Result := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>':
end; end;
@ -194,10 +219,10 @@ end;
procedure TsSpreadExcelXMLWriter.WriteBlank(AStream: TStream; procedure TsSpreadExcelXMLWriter.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);
begin begin
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s>' + // colIndex, style, hyperlink, merge '<Cell%s%s%s%s>' + // colIndex, style, hyperlink, merge
'%s' + // Comment <Comment>...</Comment> '%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), GetHyperlinkStr(ACell), GetMergeStr(ACell),
GetCommentStr(ACell) GetCommentStr(ACell)
])); ]));
@ -219,13 +244,13 @@ begin
cctStr := GetCellContentTypeStr(ACell); cctStr := GetCellContentTypeStr(ACell);
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge '<Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge
'<Data ss:Type="%s">' + // data type '<Data ss:Type="%s">' + // data type
'%s' + // value string '%s' + // value string
'</Data>' + '</Data>' +
'%s' + // Comment <Comment>...</Comment> '%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
cctStr, cctStr,
valueStr, valueStr,
@ -243,16 +268,16 @@ begin
c1 := 0; c1 := 0;
r2 := AWorksheet.GetLastRowIndex; r2 := AWorksheet.GetLastRowIndex;
c2 := AWorksheet.GetLastColIndex; c2 := AWorksheet.GetLastColIndex;
AppendToStream(AStream, AppendToStream(AStream, TABLE_INDENT +
'<Table>' + LineEnding); '<Table>' + LF);
for c := c1 to c2 do for c := c1 to c2 do
AppendToStream(AStream, AppendToStream(AStream, COL_INDENT +
' <Column ss:Width="80" />' + LineEnding); '<Column ss:Width="80" />' + LF);
for r := r1 to r2 do for r := r1 to r2 do
begin begin
AppendToStream(AStream, AppendToStream(AStream, ROW_INDENT +
' <Row>' + LineEnding); '<Row>' + LF);
for c := c1 to c2 do for c := c1 to c2 do
begin begin
cell := AWorksheet.FindCell(r, c); cell := AWorksheet.FindCell(r, c);
@ -263,12 +288,12 @@ begin
WriteCellToStream(AStream, cell); WriteCellToStream(AStream, cell);
end; end;
end; end;
AppendToStream(AStream, AppendToStream(AStream, ROW_INDENT +
' </Row>' + LineEnding); '</Row>' + LF);
end; end;
AppendToStream(AStream, AppendToStream(AStream, TABLE_INDENT +
'</Table>' + LineEnding); '</Table>' + LF);
end; end;
procedure TsSpreadExcelXMLWriter.WriteCellToStream(AStream: TStream; ACell: PCell); procedure TsSpreadExcelXMLWriter.WriteCellToStream(AStream: TStream; ACell: PCell);
@ -324,13 +349,13 @@ begin
cctStr := GetCellContentTypeStr(ACell); cctStr := GetCellContentTypeStr(ACell);
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
'<Data ss:Type="%s">' + // data type '<Data ss:Type="%s">' + // data type
'%s' + // value string '%s' + // value string
'</Data>' + '</Data>' + LF + CELL_INDENT +
'%s' + // Comment <Comment>...</Comment> '%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
cctStr, cctStr,
valueStr, valueStr,
@ -355,13 +380,13 @@ begin
formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]); formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
'<Data ss:Type="%s">' + // data type '<Data ss:Type="%s">' + // data type
'%s' + // value string '%s' + // value string
'</Data>' + '</Data>' + LF + CELL_INDENT +
'%s' + // Comment <Comment>...</Comment> '%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
cctStr, cctStr,
valueStr, valueStr,
@ -374,15 +399,15 @@ var
datemodeStr: String; datemodeStr: String;
begin begin
if FDateMode = dm1904 then if FDateMode = dm1904 then
datemodeStr := ' <Date1904/>' + LineEnding else datemodeStr := INDENT2 + '<Date1904/>' + LF else
datemodeStr := ''; datemodeStr := '';
AppendToStream(AStream, AppendToStream(AStream, INDENT1 +
'<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">' + LineEnding + '<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">' + LF +
datemodeStr + datemodeStr + INDENT2 +
'<ProtectStructure>False</ProtectStructure>' + LineEnding + '<ProtectStructure>False</ProtectStructure>' + LF + INDENT2 +
'<ProtectWindows>False</ProtectWindows>' + LineEnding + '<ProtectWindows>False</ProtectWindows>' + LF + INDENT1 +
'</ExcelWorkbook>' + LineEnding); '</ExcelWorkbook>' + LF);
end; end;
procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow, procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
@ -425,13 +450,13 @@ begin
formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]); formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
'<%sData ss:Type="%s"%s>'+ // "ss:", data type, "xmlns=.." '<%sData ss:Type="%s"%s>'+ // "ss:", data type, "xmlns=.."
'%s' + // value string '%s' + // value string
'</%sData>' + // "ss:" '</%sData>' + LF + CELL_INDENT + // "ss:"
'%s' + // Comment '%s' + // Comment
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
dataTagStr, cctStr, xmlnsStr, dataTagStr, cctStr, xmlnsStr,
valueStr, valueStr,
@ -453,13 +478,13 @@ begin
formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]); formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
end; end;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(CELL_INDENT +
' <Cell%s%s%s%s%s>' + // colIndex, style, formula, hyperlink, merge '<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
'<Data ss:Type="%s">' + // data type '<Data ss:Type="%s">' + // data type
'%g' + // value '%g' + // value
'</Data>' + '</Data>' + LF + CELL_INDENT +
'%s' + // Comment <Comment>...</Comment> '%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [ '</Cell>' + LF, [
GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell), GetIndexStr(ACol+1), GetStyleStr(ACell), formulaStr, GetHyperlinkStr(ACell), GetMergeStr(ACell),
cctStr, cctStr,
AValue, AValue,
@ -480,21 +505,21 @@ begin
deffnt := FWorkbook.GetDefaultFont; deffnt := FWorkbook.GetDefaultFont;
if AIndex = 0 then if AIndex = 0 then
begin begin
AppendToStream(AStream, Format( AppendToStream(AStream, Format(INDENT2 +
' <Style ss:ID="Default" ss:Name="Normal">' + LineEnding + '<Style ss:ID="Default" ss:Name="Normal">' + LF + INDENT3 +
' <Aligment ss:Vertical="Bottom" />' + LineEnding + '<Aligment ss:Vertical="Bottom" />' + LF + INDENT3 +
' <Borders />' + LineEnding + '<Borders />' + LF + INDENT3 +
' <Font ss:FontName="%s" x:Family="Swiss" ss:Size="%d" ss:Color="%s" />' + LineEnding + '<Font ss:FontName="%s" x:Family="Swiss" ss:Size="%d" ss:Color="%s" />' + LF + INDENT3 +
' <Interior />' + LineEnding + '<Interior />' + LF + INDENT3 +
' <NumberFormat />' + LineEnding + '<NumberFormat />' + LF + INDENT3 +
' <Protection />' + LineEnding + '<Protection />' + LF + INDENT2 +
' </Style>' + LineEnding, '</Style>' + LF,
[deffnt.FontName, round(deffnt.Size), ColorToHTMLColorStr(deffnt.Color)] ) [deffnt.FontName, round(deffnt.Size), ColorToHTMLColorStr(deffnt.Color)] )
) )
end else end else
begin begin
AppendToStream(AStream, Format( AppendToStream(AStream, Format(INDENT2 +
' <Style ss:ID="s%d">' + LineEnding, [AIndex + FMT_OFFSET])); '<Style ss:ID="s%d">' + LF, [AIndex + FMT_OFFSET]));
fmt := FWorkbook.GetPointerToCellFormat(AIndex); fmt := FWorkbook.GetPointerToCellFormat(AIndex);
@ -537,8 +562,8 @@ begin
end; end;
// Write all the alignment, text rotation and wordwrap attributes to stream // Write all the alignment, text rotation and wordwrap attributes to stream
AppendToStream(AStream, Format( AppendToStream(AStream, Format(INDENT3 +
' <Alignment %s%s%s%s />' + LineEnding, '<Alignment %s%s%s%s />' + LF,
[fmtHor, fmtVert, fmtWrap, fmtRot]) [fmtHor, fmtVert, fmtWrap, fmtRot])
); );
@ -562,16 +587,16 @@ begin
if fssStrikeout in fnt.Style then if fssStrikeout in fnt.Style then
s := s + 'ss:StrikeThrough="1" '; s := s + 'ss:StrikeThrough="1" ';
if s <> '' then if s <> '' then
AppendToStream(AStream, AppendToStream(AStream, INDENT3 +
' <Font ' + s + '/>' + LineEnding); '<Font ' + s + '/>' + LF);
end; end;
// Number Format // Number Format
if (uffNumberFormat in fmt^.UsedFormattingFields) then if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin begin
nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex); nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
AppendToStream(AStream, Format( AppendToStream(AStream, Format(INDENT3 +
' <NumberFormat ss:Format="%s"/>' + LineEnding, [nfp.NumFormatStr])); '<NumberFormat ss:Format="%s"/>' + LF, [nfp.NumFormatStr]));
end; end;
// Background // Background
@ -582,8 +607,8 @@ begin
if not (fill.Style in [fsNoFill, fsSolidFill]) then if not (fill.Style in [fsNoFill, fsSolidFill]) then
s := s + 'ss:PatternColor="' + ColorToHTMLColorStr(fill.FgColor) + '" '; s := s + 'ss:PatternColor="' + ColorToHTMLColorStr(fill.FgColor) + '" ';
s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '"'; s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '"';
AppendToStream(AStream, AppendToStream(AStream, INDENT3 +
' <Interior ' + s + '/>') '<Interior ' + s + '/>')
end; end;
// Borders // Borders
@ -593,22 +618,22 @@ begin
for cb in TsCellBorder do for cb in TsCellBorder do
if cb in fmt^.Border then begin if cb in fmt^.Border then begin
cbs := fmt^.BorderStyles[cb]; cbs := fmt^.BorderStyles[cb];
s := s + Format(' <Border ss:Position="%s" ss:LineStyle="%s"', [ s := s + INDENT4 + Format('<Border ss:Position="%s" ss:LineStyle="%s"', [
BORDER_NAMES[cb], LINE_STYLES[cbs.LineStyle]]); BORDER_NAMES[cb], LINE_STYLES[cbs.LineStyle]]);
if fmt^.BorderStyles[cb].LineStyle <> lsHair then if fmt^.BorderStyles[cb].LineStyle <> lsHair then
s := Format('%s ss:Weight="%d"', [s, LINE_WIDTHS[cbs.LineStyle]]); s := Format('%s ss:Weight="%d"', [s, LINE_WIDTHS[cbs.LineStyle]]);
if fmt^.BorderStyles[cb].Color <> scBlack then if fmt^.BorderStyles[cb].Color <> scBlack then
s := Format('%s ss:Color="%s"', [s, ColorToHTMLColorStr(cbs.Color)]); s := Format('%s ss:Color="%s"', [s, ColorToHTMLColorStr(cbs.Color)]);
s := s + '/>' + LineEnding; s := s + '/>' + LF;
end; end;
if s <> '' then if s <> '' then
AppendToStream(AStream, AppendToStream(AStream, INDENT3 +
' <Borders>' + LineEnding + s + ' <Borders>' + LF + s +
' </Borders>' + LineEnding); ' </Borders>' + LF);
end; end;
AppendToStream(AStream, AppendToStream(AStream, INDENT2 +
' </Style>' + LineEnding); '</Style>' + LF);
end; end;
end; end;
@ -616,11 +641,11 @@ procedure TsSpreadExcelXMLWriter.WriteStyles(AStream: TStream);
var var
i: Integer; i: Integer;
begin begin
AppendToStream(AStream, AppendToStream(AStream, INDENT1 +
'<Styles>' + LineEnding); '<Styles>' + LF);
for i:=0 to FWorkbook.GetNumCellFormats-1 do WriteStyle(AStream, i); for i:=0 to FWorkbook.GetNumCellFormats-1 do WriteStyle(AStream, i);
AppendToStream(AStream, AppendToStream(AStream, INDENT1 +
'</Styles>' + LineEnding); '</Styles>' + LF);
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -654,15 +679,15 @@ end;
procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream); procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream);
begin begin
AppendToStream(AStream, AppendToStream(AStream,
'<?xml version="1.0"?>' + LineEnding + '<?xml version="1.0"?>' + LF +
'<?mso-application progid="Excel.Sheet"?>' + LineEnding '<?mso-application progid="Excel.Sheet"?>' + LF
); );
AppendToStream(AStream, AppendToStream(AStream,
'<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding + '<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"' + LF +
' xmlns:o="urn:schemas-microsoft-com:office:office"' + LineEnding + ' xmlns:o="urn:schemas-microsoft-com:office:office"' + LF +
' xmlns:x="urn:schemas-microsoft-com:office:excel"' + LineEnding + ' xmlns:x="urn:schemas-microsoft-com:office:excel"' + LF +
' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding + ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LF +
' xmlns:html="http://www.w3.org/TR/REC-html40">' + LineEnding); ' xmlns:html="http://www.w3.org/TR/REC-html40">' + LF);
WriteExcelWorkbook(AStream); WriteExcelWorkbook(AStream);
WriteStyles(AStream); WriteStyles(AStream);
@ -677,11 +702,10 @@ procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
begin begin
FWorksheet := AWorksheet; FWorksheet := AWorksheet;
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<Worksheet ss:Name="%s">' + LineEnding, [AWorksheet.Name]) ' <Worksheet ss:Name="%s">' + LF, [AWorksheet.Name]) );
);
WriteCells(AStream, AWorksheet); WriteCells(AStream, AWorksheet);
AppendToStream(AStream, AppendToStream(AStream,
'</Worksheet>' + LineEnding ' </Worksheet>' + LF
); );
end; end;