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

fpspreadsheet: OOXML reading/writing support for frozen panes. Simplify OOXML's cell writing strategy by omitting empty cells.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3422 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-04 19:11:17 +00:00
parent 3d82a35d56
commit d0be6284cf
4 changed files with 453 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files

225
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -493,6 +493,8 @@ type
FLeftPaneWidth: Integer;
FTopPaneHeight: Integer;
FOptions: TsSheetOptions;
FFirstRowIndex: Cardinal;
FFirstColIndex: Cardinal;
FLastRowIndex: Cardinal;
FLastColIndex: Cardinal;
FOnChangeCell: TsCellEvent;
@ -620,16 +622,24 @@ type
procedure WriteBorderStyles(ARow, ACol: Cardinal; const AStyles: TsCellBorderStyles); overload;
procedure WriteBorderStyles(ACell: PCell; const AStyles: TsCellBorderStyles); overload;
procedure WriteDateTimeFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat;
const AFormatString: String = ''); overload;
procedure WriteDateTimeFormat(ACell: PCell; ANumberFormat: TsNumberFormat;
const AFormatString: String = ''); overload;
procedure WriteDecimals(ARow, ACol: Cardinal; ADecimals: byte); overload;
procedure WriteDecimals(ACell: PCell; ADecimals: Byte); overload;
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
function WriteFont(ACell: PCell; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer;
function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer;
function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer;
function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; overload;
function WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; overload;
procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
@ -666,8 +676,10 @@ type
function GetNextCell(): PCell;
function GetFirstCellOfRow(ARow: Cardinal): PCell;
function GetLastCellOfRow(ARow: Cardinal): PCell;
function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex';
function GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastRowIndex(AForceCalculation: Boolean = false): Cardinal;
function GetLastRowNumber: Cardinal; deprecated 'Use GetLastRowIndex';
@ -1573,6 +1585,8 @@ begin
FRows := TIndexedAVLTree.Create(@CompareRows);
FCols := TIndexedAVLTree.Create(@CompareCols);
FFirstRowIndex := $FFFFFFFF;
FFirstColIndex := $FFFFFFFF;
FLastRowIndex := 0;
FLastColIndex := 0;
@ -1923,6 +1937,10 @@ begin
Result^.BorderStyles := DEFAULT_BORDERSTYLES;
Cells.Add(Result);
if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true)
else FFirstColIndex := Min(FFirstColIndex, ACol);
if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true)
else FFirstRowIndex := Min(FFirstRowIndex, ARow);
if FLastColIndex = 0 then FLastColIndex := GetLastColIndex(true)
else FLastColIndex := Max(FLastColIndex, ACol);
if FLastRowIndex = 0 then FLastRowIndex := GetLastRowIndex(true)
@ -2055,6 +2073,46 @@ begin
else Result := nil;
end;
{@@
Returns the 0-based index of the first column with a cell with contents.
If no cells have contents, zero will be returned, which is also a valid value.
Use GetCellCount to verify if there is at least one cell with contents in the
worksheet.
@param AForceCalculation The index of the first column is continuously updated
whenever a new cell is created. If AForceCalculation
is true all cells are scanned to determine the index
of the first column.
@see GetCellCount
}
function TsWorksheet.GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal;
var
AVLNode: TAVLTreeNode;
i: Integer;
begin
if AForceCalculation then begin
Result := $FFFFFFFF;
// Traverse the tree from lowest to highest.
// Since tree primary sort order is on row lowest col could exist anywhere.
AVLNode := FCells.FindLowest;
While Assigned(AVLNode) do begin
Result := Math.Min(Result, PCell(AVLNode.Data)^.Col);
AVLNode := FCells.FindSuccessor(AVLNode);
end;
// In addition, there may be column records defining the column width even
// without content
for i:=0 to FCols.Count-1 do
if FCols[i] <> nil then
Result := Math.Min(Result, PCol(FCols[i])^.Col);
// Store the result
FFirstColIndex := Result;
end
else
Result := FFirstColIndex;
end;
{@@
Returns the 0-based index of the last column with a cell with contents.
@ -2145,6 +2203,41 @@ begin
end;
end;
{@@
Returns the 0-based index of the first row with a cell with contents.
If no cells have contents, zero will be returned, which is also a valid value.
Use GetCellCount to verify if there is at least one cell with contents in the
worksheet.
@param AForceCalculation The index of the first row is continuously updated
whenever a new cell is created. If AForceCalculation
is true all cells are scanned to determine the index
of the first row.
@see GetCellCount
}
function TsWorksheet.GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal;
var
AVLNode: TAVLTreeNode;
i: Integer;
begin
if AForceCalculation then begin
Result := $FFFFFFFF;
AVLNode := FCells.FindLowest;
if Assigned(AVLNode) then
Result := PCell(AVLNode.Data).Row;
// In addition, there may be row records even for rows without cells.
for i:=0 to FRows.Count-1 do
if FRows[i] <> nil then
Result := Math.Min(Result, PRow(FRows[i])^.Row);
// Store result
FFirstRowIndex := Result;
end
else
Result := FFirstRowIndex
end;
{@@
Returns the 0-based index of the last row with a cell with contents.
@ -2620,6 +2713,8 @@ end;
}
procedure TsWorksheet.UpdateCaches;
begin
FFirstColIndex := GetFirstColIndex(true);
FFirstRowIndex := GetFirstRowIndex(true);
FLastColIndex := GetLastColIndex(true);
FLastRowIndex := GetLastRowIndex(true);
end;
@ -3164,6 +3259,62 @@ begin
WriteDateTime(ACell, AValue, nfCustom, AFormatStr);
end;
{@@
Adds a date/time format to the formatting of a cell
@param ARow The row of the cell
@param ACol The column of the cell
@param ANumberFormat Identifier of the format to be applied (nfXXXX constant)
@param AFormatString optional string of formatting codes. Is only considered
if ANumberFormat is nfCustom.
@see TsNumberFormat
}
procedure TsWorksheet.WriteDateTimeFormat(ARow, ACol: Cardinal;
ANumberFormat: TsNumberFormat; const AFormatString: String = '');
begin
WriteDateTimeFormat(GetCell(ARow, ACol), ANumberFormat, AFormatString);
end;
{@@
Adds a date/time format to the formatting of a cell
@param ACell Pointer to the cell considered
@param ANumberFormat Identifier of the format to be applied (nxXXXX constant)
@param AFormatString optional string of formatting codes. Is only considered
if ANumberFormat is nfCustom.
@see TsNumberFormat
}
procedure TsWorksheet.WriteDateTimeFormat(ACell: PCell;
ANumberFormat: TsNumberFormat; const AFormatString: String = '');
begin
if ACell = nil then
exit;
if not ((ANumberFormat in [nfGeneral, nfCustom]) or IsDateTimeFormat(ANumberFormat)) then
raise Exception.Create('WriteDateTimeFormat can only be called with date/time formats.');
ACell^.NumberFormat := ANumberFormat;
if (ANumberFormat <> nfGeneral) then begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
if (AFormatString = '') then
ACell^.NumberFormatStr := BuildDateTimeFormatString(ANumberFormat, Workbook.FormatSettings)
else
ACell^.NumberFormatStr := AFormatString;
end else begin
Exclude(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormatStr := '';
end;
ChangedCell(ACell^.Row, ACell^.Col);
end;
{@@
Formats the number in a cell to show a given count of decimal places.
Is ignored for non-decimal formats (such as most date/time formats).
@ -3401,16 +3552,36 @@ end;
}
function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer;
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
Include(lCell^.UsedFormattingFields, uffFont);
Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle, AFontColor);
end;
{@@
Adds font specification to the formatting of a cell. Looks in the workbook's
FontList and creates an new entry if the font is not used so far. Returns the
index of the font in the font list.
@param ACell Pointer to the cell considered
@param AFontName Name of the font
@param AFontSize Size of the font, in points
@param AFontStyle Set with font style attributes
(don't use those of unit "graphics" !)
@return Index of the font in the workbook's font list.
}
function TsWorksheet.WriteFont(ACell: PCell; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer;
begin
if ACell = nil then begin
Result := -1;
Exit;
end;
Include(ACell^.UsedFormattingFields, uffFont);
Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor);
if Result = -1 then
result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor);
lCell^.FontIndex := Result;
ChangedFont(ARow, ACol);
ACell^.FontIndex := Result;
ChangedFont(ACell^.Row, ACell^.Col);
end;
{@@
@ -3513,13 +3684,33 @@ end;
}
function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal;
AStyle: TsFontStyles): Integer;
begin
Result := WriteFontStyle(GetCell(ARow, ACol), AStyle);
end;
{@@
Replaces the font style (bold, italic, etc) in formatting of a cell.
Looks in the workbook's font list if this modified font has already been used.
If not a new font entry is created.
Returns the index of this font in the font list.
@param ACell Pointer to the cell considered
@param AStyle New font style to be used
@return Index of the font in the workbook's font list.
@see TsFontStyle
}
function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer;
var
lCell: PCell;
fnt: TsFont;
begin
lCell := GetCell(ARow, ACol);
fnt := Workbook.GetFont(lCell^.FontIndex);
Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, AStyle, fnt.Color);
if ACell = nil then begin
Result := -1;
exit;
end;
fnt := Workbook.GetFont(ACell^.FontIndex);
Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color);
end;
{@@
@ -3893,7 +4084,7 @@ var
begin
Result := 0;
h0 := Workbook.GetDefaultFontSize;
for col := 0 to GetLastColIndex do begin
for col := GetFirstColIndex to GetLastColIndex do begin
cell := FindCell(ARow, col);
if cell <> nil then
Result := Max(Result, Workbook.GetFont(cell^.FontIndex).Size / h0);
@ -3972,10 +4163,12 @@ begin
FillChar(Result^, SizeOf(TCol), #0);
Result^.Col := ACol;
FCols.Add(Result);
if FLastColIndex = 0 then
FLastColIndex := GetLastColIndex(true)
else
FLastColIndex := Max(FLastColIndex, ACol);
if FFirstColIndex = 0
then FFirstColIndex := GetFirstColIndex(true)
else FFirstColIndex := Min(FFirstColIndex, ACol);
if FLastColIndex = 0
then FLastColIndex := GetLastColIndex(true)
else FLastColIndex := Max(FLastColIndex, ACol);
end;
end;

26
components/fpspreadsheet/tests/optiontests.pas
View File

@ -75,6 +75,11 @@ type
procedure TestWriteRead_OOXML_ShowGridLines_HideHeaders;
procedure TestWriteRead_OOXML_HideGridLines_ShowHeaders;
procedure TestWriteRead_OOXML_HideGridLines_HideHeaders;
procedure TestWriteRead_OOXML_Panes_HorVert;
procedure TestWriteRead_OOXML_Panes_Hor;
procedure TestWriteRead_OOXML_Panes_Vert;
procedure TestWriteRead_OOXML_Panes_None;
end;
implementation
@ -358,6 +363,27 @@ begin
TestWriteReadPanes(sfOpenDocument, 0, 0);
end;
{ Tests for OOXML frozen panes }
procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_HorVert;
begin
TestWriteReadPanes(sfOOXML, 1, 2);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_Hor;
begin
TestWriteReadPanes(sfOOXML, 1, 0);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_Vert;
begin
TestWriteReadPanes(sfOOXML, 0, 2);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_None;
begin
TestWriteReadPanes(sfOOXML, 0, 0);
end;
initialization
RegisterTest(TSpreadWriteReadOptionsTests);

9
components/fpspreadsheet/xlscommon.pas
View File

@ -2676,6 +2676,7 @@ var
lCell: TCell;
value: variant;
styleCell: PCell;
begin
for r := 0 to Workbook.VirtualRowCount-1 do begin
for c := 0 to Workbook.VirtualColCount-1 do begin
@ -2693,12 +2694,10 @@ begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end else
{
if VarIsDateTime(value) then begin
lCell.ContentType := cctNumber;
lCell.DateTimeValue := value;
if VarType(value) = varDate then begin
lCell.ContentType := cctDateTime;
lCell.DateTimeValue := StrToDate(VarToStr(value), Workbook.FormatSettings);
end else
}
if VarIsStr(value) then begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');

381
components/fpspreadsheet/xlsxooxml.pas
View File

@ -112,11 +112,13 @@ type
procedure ListAllFills;
procedure ResetStreams;
procedure WriteBorderList(AStream: TStream);
procedure WriteCols(AStream: TStream; ASheet: TsWorksheet);
procedure WriteCols(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteFillList(AStream: TStream);
procedure WriteFontList(AStream: TStream);
procedure WriteNumFormatList(AStream: TStream);
procedure WritePalette(AStream: TStream);
procedure WriteSheetData(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteSheetViews(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteStyleList(AStream: TStream; ANodeName: String);
protected
{ Streams with the contents of files }
@ -133,7 +135,7 @@ type
{ Routines to write the files }
procedure WriteGlobalFiles;
procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
procedure WriteWorksheet(AWorksheet: TsWorksheet);
protected
{ Record writing methods }
//todo: add WriteDate
@ -153,7 +155,7 @@ type
implementation
uses
variants, fileutil, fpsStreams, fpsNumFormatParser;
variants, fileutil, StrUtils, fpsStreams, fpsNumFormatParser;
const
{ OOXML general XML constants }
@ -1018,12 +1020,25 @@ end;
procedure TsSpreadOOXMLReader.ReadSheetViews(ANode: TDOMNode; AWorksheet: TsWorksheet);
var
sheetViewNode: TDOMNode;
childNode: TDOMNode;
nodeName: String;
s: String;
begin
if ANode = nil then
exit;
{
'<sheetViews>' +
'<sheetView workbookViewId="0" %s%s>'+
'<pane xSplit="%d" ySplit="%d" topLeftCell="%s" activePane="bottomRight" state="frozen" />' +
'<selection pane="topRight" activeCell="%s" sqref="%s" />' +
'<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
'<selection pane="bottomRight" activeCell="%s" sqref="%s" />' +
'</sheetView>' +
'</sheetViews>', [
}
sheetViewNode := ANode.FirstChild;
while Assigned(sheetViewNode) do begin
nodeName := sheetViewNode.NodeName;
@ -1034,6 +1049,22 @@ begin
s := GetAttrValue(sheetViewNode, 'showRowColHeaders');
if s = '0' then
AWorksheet.Options := AWorksheet.Options - [soShowHeaders];
childNode := sheetViewNode.FirstChild;
while Assigned(childNode) do begin
nodeName := childNode.NodeName;
if nodeName = 'pane' then begin
s := GetAttrValue(childNode, 'state');
if s = 'frozen' then begin
AWorksheet.Options := AWorksheet.Options + [soHasFrozenPanes];
s := GetAttrValue(childNode, 'xSplit');
if s <> '' then AWorksheet.LeftPaneWidth := StrToInt(s);
s := GetAttrValue(childNode, 'ySplit');
if s <> '' then AWorksheet.TopPaneHeight := StrToInt(s);
end;
end;
childNode := childNode.NextSibling;
end;
end;
sheetViewNode := sheetViewNode.NextSibling;
end;
@ -1422,19 +1453,19 @@ begin
'</borders>');
end;
procedure TsSpreadOOXMLWriter.WriteCols(AStream: TStream; ASheet: TsWorksheet);
procedure TsSpreadOOXMLWriter.WriteCols(AStream: TStream; AWorksheet: TsWorksheet);
var
col: PCol;
c: Integer;
begin
if ASheet.Cols.Count = 0 then
if AWorksheet.Cols.Count = 0 then
exit;
AppendToStream(AStream,
'<cols>');
for c:=0 to ASheet.GetLastColIndex do begin
col := ASheet.FindCol(c);
for c:=0 to AWorksheet.GetLastColIndex do begin
col := AWorksheet.FindCol(c);
if col <> nil then
AppendToStream(AStream, Format(
'<col min="%d" max="%d" width="%g" customWidth="1" />',
@ -1580,6 +1611,175 @@ begin
'</colors>');
end;
procedure TsSpreadOOXMLWriter.WriteSheetData(AStream: TStream;
AWorksheet: TsWorksheet);
var
r, c, c1, c2: Cardinal;
row: PRow;
value: Variant;
lCell: TCell;
styleCell: PCell;
AVLNode: TAVLTreeNode;
rh: String;
h0: Single;
begin
h0 := Workbook.GetDefaultFontSize; // Point size of default font
AppendToStream(AStream,
'<sheetData>');
if (boVirtualMode in Workbook.Options) and Assigned(Workbook.OnWriteCellData)
then begin
for r := 0 to Workbook.VirtualRowCount-1 do begin
row := AWorksheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%g" customHeight="1"', [
(row^.Height + ROW_HEIGHT_CORRECTION)*h0])
else
rh := '';
AppendToStream(AStream, Format(
'<row r="%d" spans="1:%d"%s>', [r+1, Workbook.VirtualColCount, rh]));
for c := 0 to Workbook.VirtualColCount-1 do begin
InitCell(lCell);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
if styleCell <> nil then
lCell := styleCell^;
lCell.Row := r;
lCell.Col := c;
if VarIsNull(value) then
lCell.ContentType := cctEmpty
else
if VarIsNumeric(value) then begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end else
if VarType(value) = varDate then begin
lCell.ContentType := cctDateTime;
lCell.DateTimeValue := StrToDate(VarToStr(value), Workbook.FormatSettings);
end else
if VarIsStr(value) then begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');
end else
if VarIsBool(value) then begin
lCell.ContentType := cctBool;
lCell.BoolValue := value <> 0;
end;
WriteCellCallback(@lCell, AStream);
varClear(value);
end;
AppendToStream(AStream,
'</row>');
end;
end else
begin
// The cells need to be written in order, row by row, cell by cell
for r := 0 to AWorksheet.GetLastRowIndex do begin
// If the row has a custom height add this value to the <row> specification
row := AWorksheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%g" customHeight="1"', [
(row^.Height + ROW_HEIGHT_CORRECTION)*h0])
else
rh := '';
c1 := AWorksheet.GetFirstColIndex;
c2 := AWorksheet.GetLastColIndex;
AppendToStream(AStream, Format(
'<row r="%d" spans="%d:%d"%s>', [r+1, c1+1, c2+1, rh]));
// Write cells belonging to this row.
for c := c1 to c2 do begin
lCell.Row := r;
lCell.Col := c;
AVLNode := AWorksheet.Cells.Find(@lCell);
if Assigned(AVLNode) then
WriteCellCallback(PCell(AVLNode.Data), AStream);
end;
AppendToStream(AStream,
'</row>');
end;
end;
AppendToStream(AStream,
'</sheetData>');
end;
procedure TsSpreadOOXMLWriter.WriteSheetViews(AStream: TStream;
AWorksheet: TsWorksheet);
var
showGridLines: String;
showHeaders: String;
topRightCell: String;
bottomLeftCell: String;
bottomRightCell: String;
begin
// Show gridlines ?
showGridLines := IfThen(soShowGridLines in AWorksheet.Options, ' ', 'showGridLines="0" ');
// Show headers?
showHeaders := IfThen(soShowHeaders in AWorksheet.Options, ' ', 'showRowColHeaders="0" ');
// No frozen panes
if not (soHasFrozenPanes in AWorksheet.Options) or
((AWorksheet.LeftPaneWidth = 0) and (AWorksheet.TopPaneHeight = 0))
then
AppendToStream(AStream, Format(
'<sheetViews>' +
'<sheetView workbookViewId="0" %s%s/>' +
// <sheetView workbookViewID="0" />
'</sheetViews>', [
showGridLines, showHeaders
]))
else
begin // Frozen panes
topRightCell := GetCellString(0, AWorksheet.LeftPaneWidth, [rfRelRow, rfRelCol]);
bottomLeftCell := GetCellString(AWorksheet.TopPaneHeight, 0, [rfRelRow, rfRelCol]);
bottomRightCell := GetCellString(AWorksheet.TopPaneHeight, AWorksheet.LeftPaneWidth, [rfRelRow, rfRelCol]);
if (AWorksheet.LeftPaneWidth > 0) and (AWorksheet.TopPaneHeight > 0) then
AppendToStream(AStream, Format(
'<sheetViews>' +
'<sheetView workbookViewId="0" %s%s>'+
'<pane xSplit="%d" ySplit="%d" topLeftCell="%s" activePane="bottomRight" state="frozen" />' +
'<selection pane="topRight" activeCell="%s" sqref="%s" />' +
'<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
'<selection pane="bottomRight" activeCell="%s" sqref="%s" />' +
'</sheetView>' +
'</sheetViews>', [
showGridLines, showHeaders,
AWorksheet.LeftPaneWidth, AWorksheet.TopPaneHeight, bottomRightCell,
topRightCell, topRightCell,
bottomLeftCell, bottomLeftCell,
bottomRightCell, bottomrightCell
]))
else
if (AWorksheet.LeftPaneWidth > 0) then
AppendToStream(AStream, Format(
'<sheetViews>' +
'<sheetView workbookViewId="0" %s%s>'+
'<pane xSplit="%d" topLeftCell="%s" activePane="topRight" state="frozen" />' +
'<selection pane="topRight" activeCell="%s" sqref="%s" />' +
'</sheetView>' +
'</sheetViews>', [
showGridLines, showHeaders,
AWorksheet.LeftPaneWidth, topRightCell,
topRightCell, topRightCell
]))
else
if (AWorksheet.TopPaneHeight > 0) then
AppendToStream(AStream, Format(
'<sheetViews>'+
'<sheetView workbookViewId="0" %s%s>'+
'<pane ySplit="%d" topLeftCell="%s" activePane="bottomLeft" state="frozen" />'+
'<selection pane="bottomLeft" activeCell="%s" sqref="%s" />' +
'</sheetView>'+
'</sheetViews>', [
showGridLines, showHeaders,
AWorksheet.TopPaneHeight, bottomLeftCell,
bottomLeftCell, bottomLeftCell
]));
end;
end;
{ Writes the style list which the writer has collected in FFormattingStyles. }
procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String);
var
@ -1710,7 +1910,7 @@ begin
AppendToStream(FSRelsRels, Format(
'<Relationships xmlns="%s">', [SCHEMAS_RELS]));
AppendToStream(FSRelsRels, Format(
'<Relationship Type="%s" Target="xl/workbook.xml" Id="rId1" />', [SCHEMAS_DOCUMENT]));
'<Relationship Type="%s" Target="xl/workbook.xml" Id="rId1" />', [SCHEMAS_DOCUMENT]));
AppendToStream(FSRelsRels,
'</Relationships>');
@ -1793,8 +1993,8 @@ begin
AppendToStream(FSWorkbook,
'<workbookPr defaultThemeVersion="124226" />');
AppendToStream(FSWorkbook,
'<bookViews>',
'<workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />',
'<bookViews>' +
'<workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />' +
'</bookViews>');
AppendToStream(FSWorkbook,
'<sheets>');
@ -1826,63 +2026,10 @@ begin
'</sst>');
end;
{
FSheets[CurStr] :=
XML_HEADER + LineEnding +
'<worksheet xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding +
' <sheetViews>' + LineEnding +
' <sheetView workbookViewId="0" />' + LineEnding +
' </sheetViews>' + LineEnding +
' <sheetData>' + LineEnding +
' <row r="1" spans="1:4">' + LineEnding +
' <c r="A1">' + LineEnding +
' <v>1</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="B1">' + LineEnding +
' <v>2</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="C1">' + LineEnding +
' <v>3</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="D1">' + LineEnding +
' <v>4</v>' + LineEnding +
' </c>' + LineEnding +
' </row>' + LineEnding +
' <row r="2" spans="1:4">' + LineEnding +
' <c r="A2" t="s">' + LineEnding +
' <v>0</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="B2" t="s">' + LineEnding +
' <v>1</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="C2" t="s">' + LineEnding +
' <v>2</v>' + LineEnding +
' </c>' + LineEnding +
' <c r="D2" t="s">' + LineEnding +
' <v>3</v>' + LineEnding +
' </c>' + LineEnding +
' </row>' + LineEnding +
' </sheetData>' + LineEnding +
'</worksheet>';
}
procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet);
var
r, c: Cardinal;
LastColIndex: Cardinal;
lCell: TCell;
AVLNode: TAVLTreeNode;
CellPosText: string;
value: Variant;
styleCell: PCell;
row: PRow;
rh: String;
h0: Single;
showGridLines: String;
showHeaders: String;
procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet);
begin
FCurSheetNum := Length(FSSheets);
SetLength(FSSheets, FCurSheetNum + 1);
h0 := Workbook.GetDefaultFontSize; // Point size of default font
// Create the stream
if (boBufStream in Workbook.Options) then
@ -1891,117 +2038,17 @@ begin
FSSheets[FCurSheetNum] := TMemoryStream.Create;
// Header
if not (soShowGridLines in CurSheet.Options) then
showGridLines := 'showGridLines="0"'
else
showGridLines := '';
if not (soShowHeaders in CurSheet.Options) then
showHeaders := 'showRowColHeaders="0"'
else
showHeaders := '';
AppendToStream(FSSheets[FCurSheetNum],
XML_HEADER);
AppendToStream(FSSheets[FCurSheetNum], Format(
'<worksheet xmlns="%s" xmlns:r="%s">', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS]));
AppendToStream(FSSheets[FCurSheetNum],
'<sheetViews>');
AppendToStream(FSSheets[FCurSheetNum], Format(
'<sheetView workbookViewId="0" %s %s />', [showGridLines, showHeaders]));
AppendToStream(FSSheets[FCurSheetNum],
'</sheetViews>');
WriteCols(FSSheets[FCurSheetNum], CurSheet);
AppendToStream(FSSheets[FCurSheetNum],
'<sheetData>');
if (boVirtualMode in Workbook.Options) and Assigned(Workbook.OnWriteCellData)
then begin
for r := 0 to Workbook.VirtualRowCount-1 do begin
row := CurSheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%g" customHeight="1"', [
(row^.Height + ROW_HEIGHT_CORRECTION)*h0])
else
rh := '';
AppendToStream(FSSheets[FCurSheetNum], Format(
'<row r="%d" spans="1:%d"%s>', [r+1, Workbook.VirtualColCount, rh]));
for c := 0 to Workbook.VirtualColCount-1 do begin
InitCell(lCell);
CellPosText := CurSheet.CellPosToText(r, c);
value := varNull;
styleCell := nil;
Workbook.OnWriteCellData(Workbook, r, c, value, styleCell);
if styleCell <> nil then
lCell := styleCell^;
lCell.Row := r;
lCell.Col := c;
if VarIsNull(value) then
lCell.ContentType := cctEmpty
else
if VarIsNumeric(value) then begin
lCell.ContentType := cctNumber;
lCell.NumberValue := value;
end
{
else if VarIsDateTime(value) then begin
lCell.ContentType := cctNumber;
lCell.DateTimeValue := value;
end
}
else if VarIsStr(value) then begin
lCell.ContentType := cctUTF8String;
lCell.UTF8StringValue := VarToStrDef(value, '');
end else
if VarIsBool(value) then begin
lCell.ContentType := cctBool;
lCell.BoolValue := value <> 0;
end;
WriteCellCallback(@lCell, FSSheets[FCurSheetNum]);
varClear(value);
end;
AppendToStream(FSSheets[FCurSheetNum],
'</row>');
end;
end else
begin
// The cells need to be written in order, row by row, cell by cell
LastColIndex := CurSheet.GetLastColIndex;
for r := 0 to CurSheet.GetLastRowIndex do begin
// If the row has a custom height add this value to the <row> specification
row := CurSheet.FindRow(r);
if row <> nil then
rh := Format(' ht="%g" customHeight="1"', [
(row^.Height + ROW_HEIGHT_CORRECTION)*h0])
else
rh := '';
AppendToStream(FSSheets[FCurSheetNum], Format(
'<row r="%d" spans="1:%d"%s>', [r+1, LastColIndex+1, rh]));
// Write cells belonging to this row.
for c := 0 to LastColIndex do begin
LCell.Row := r;
LCell.Col := c;
AVLNode := CurSheet.Cells.Find(@LCell);
if Assigned(AVLNode) then
WriteCellCallback(PCell(AVLNode.Data), FSSheets[FCurSheetNum])
else begin
CellPosText := CurSheet.CellPosToText(r, c);
AppendToStream(FSSheets[FCurSheetNum], Format(
'<c r="%s">', [CellPosText]),
'<v></v>',
'</c>');
end;
end;
AppendToStream(FSSheets[FCurSheetNum],
'</row>');
end;
end;
WriteSheetViews(FSSheets[FCurSheetNum], AWorksheet);
WriteCols(FSSheets[FCurSheetNum], AWorksheet);
WriteSheetData(FSSheets[FCurSheetNum], AWorksheet);
// Footer
AppendToStream(FSSheets[FCurSheetNum],
'</sheetData>' +
'</worksheet>');
end;