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

fpspreadsheet: Read frozen panes from ods files. Add test case for writing/reading of ods panes, passed.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3210 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-21 16:09:08 +00:00
parent e3ece8a30b
commit d75755c1ff
8 changed files with 136 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -48,6 +48,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
@ -79,6 +82,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item3>
</BuildModes>
@ -137,6 +143,9 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">

96
components/fpspreadsheet/fpsopendocument.pas
View File

@ -80,8 +80,6 @@ type
FRowList: TFPList;
FVolatileNumFmtList: TsCustomNumFormatList;
FDateMode: TDateMode;
FShowGrid: Boolean;
FShowHeaders: Boolean;
// Applies internally stored column widths to current worksheet
procedure ApplyColWidths;
// Applies a style to a cell
@ -1233,17 +1231,6 @@ begin
Doc := nil;
try
// process the settings.xml file (Note: it does not always exist!)
if FileExists(FilePath + 'settings.xml') then begin
ReadXMLFile(Doc, FilePath+'settings.xml');
DeleteFile(FilePath+'settings.xml');
OfficeSettingsNode := Doc.DocumentElement.FindNode('office:settings');
ReadSettings(OfficeSettingsNode);
Doc.Free;
end;
// process the styles.xml file
ReadXMLFile(Doc, FilePath+'styles.xml');
DeleteFile(FilePath+'styles.xml');
@ -1281,9 +1268,6 @@ begin
continue;
end;
FWorkSheet := aData.AddWorksheet(GetAttrValue(TableNode,'table:name'));
if not FShowGrid then FWorksheet.Options := FWorksheet.Options - [soShowGridLines];
if not FShowHeaders then FWorksheet.Options := FWorksheet.Options - [soShowHeaders];
// Collect column styles used
ReadColumns(TableNode);
// Process each row inside the sheet and process each cell of the row
@ -1293,6 +1277,17 @@ begin
TableNode := TableNode.NextSibling;
end; //while Assigned(TableNode)
Doc.Free;
// process the settings.xml file (Note: it does not always exist!)
if FileExists(FilePath + 'settings.xml') then begin
ReadXMLFile(Doc, FilePath+'settings.xml');
DeleteFile(FilePath+'settings.xml');
OfficeSettingsNode := Doc.DocumentElement.FindNode('office:settings');
ReadSettings(OfficeSettingsNode);
end;
finally
if Assigned(Doc) then Doc.Free;
end;
@ -1906,9 +1901,15 @@ end;
procedure TsSpreadOpenDocReader.ReadSettings(AOfficeSettingsNode: TDOMNode);
var
cfgItemSetNode, cfgItemNode, cfgItemMapEntryNode, cfgEntryItemNode, node: TDOMNode;
nodeName, cfgName, cfgValue: String;
cfgItemSetNode, cfgItemNode, cfgItemMapEntryNode, cfgEntryItemNode, cfgTableItemNode, node: TDOMNode;
nodeName, cfgName, cfgValue, tblName: String;
sheet: TsWorksheet;
vsm, hsm, hsp, vsp: Integer;
showGrid, showHeaders: Boolean;
i: Integer;
begin
showGrid := true;
showHeaders := true;
cfgItemSetNode := AOfficeSettingsNode.FirstChild;
while Assigned(cfgItemSetNode) do begin
if (cfgItemSetNode.NodeName <> '#text') and
@ -1930,11 +1931,52 @@ begin
cfgName := lowercase(GetAttrValue(cfgEntryItemNode, 'config:name'));
if cfgName = 'showgrid' then begin
cfgValue := GetNodeValue(cfgEntryItemNode);
if cfgValue = 'false' then FShowGrid := false else FShowGrid := true;
if cfgValue = 'false' then showGrid := false;
end else
if cfgName = 'hascolumnrowheaders' then begin
cfgValue := GetNodeValue(cfgEntryItemNode);
if cfgValue = 'false' then FShowHeaders := false else FShowHeaders := true;
if cfgValue = 'false' then showHeaders := false;
end;
end else
if (nodeName <> '#text') and (nodeName = 'config:config-item-map-named') and
(GetAttrValue(cfgEntryItemNode, 'config:name') = 'Tables')
then begin
cfgTableItemNode := cfgEntryItemNode.FirstChild;
while Assigned(cfgTableItemNode) do begin
nodeName := cfgTableItemNode.NodeName;
if nodeName <> '#text' then begin
tblName := GetAttrValue(cfgTableItemNode, 'config:name');
if tblName <> '' then begin
hsm := 0; vsm := 0;
sheet := Workbook.GetWorksheetByName(tblName);
if sheet <> nil then begin
node := cfgTableItemNode.FirstChild;
while Assigned(node) do begin
nodeName := node.NodeName;
if nodeName <> '#text' then begin
cfgName := GetAttrValue(node, 'config:name');
cfgValue := GetNodeValue(node);
if cfgName = 'VerticalSplitMode' then
vsm := StrToInt(cfgValue)
else if cfgName = 'HorizontalSplitMode' then
hsm := StrToInt(cfgValue)
else if cfgName = 'VerticalSplitPosition' then
vsp := StrToInt(cfgValue)
else if cfgName = 'HorizontalSplitPosition' then
hsp := StrToInt(cfgValue);
end;
node := node.NextSibling;
end;
if (hsm = 2) or (vsm = 2) then begin
sheet.Options := sheet.Options + [soHasFrozenPanes];
sheet.LeftPaneWidth := hsp;
sheet.TopPaneHeight := vsp;
end else
sheet.Options := sheet.Options - [soHasFrozenPanes];
end;
end;
end;
cfgTableItemNode := cfgTableItemNode.NextSibling;
end;
end;
cfgEntryItemNode := cfgEntryItemNode.NextSibling;
@ -1947,6 +1989,14 @@ begin
end;
cfgItemSetNode := cfgItemSetNode.NextSibling;
end;
{ Now let's apply the showGrid and showHeader values to all sheets - they
are document-wide settings (although there is a ShowGrid in the Tables node) }
for i:=0 to Workbook.GetWorksheetCount-1 do begin
sheet := Workbook.GetWorksheetByIndex(i);
if not showGrid then sheet.Options := sheet.Options - [soShowGridLines];
if not showHeaders then sheet.Options := sheet.Options - [soShowHeaders];
end;
end;
procedure TsSpreadOpenDocReader.ReadStyles(AStylesNode: TDOMNode);
@ -2345,6 +2395,9 @@ var
showGrid, showHeaders: Boolean;
sheet: TsWorksheet;
begin
// Open/LibreOffice allow to change showGrid and showHeaders only globally.
// As a compromise, we check whether there is at least one page with these
// settings off. Then we assume it to be valid also for the other sheets.
showGrid := true;
showHeaders := true;
for i:=0 to Workbook.GetWorksheetCount-1 do begin
@ -3163,7 +3216,8 @@ begin
' <config:config-item config:name="PositionRight" config:type="int">'+IntToStr(sheet.LeftPaneWidth)+'</config:config-item>' + LineEnding + AIndent +
' <config:config-item config:name="PositionTop" config:type="int">0</config:config-item>' + LineEnding + AIndent +
' <config:config-item config:name="PositionBottom" config:type="int">'+IntToStr(sheet.TopPaneHeight)+'</config:config-item>' + LineEnding + AIndent +
' <config:config-item config:name="ShowGrid" config:type="boolean">'+FALSE_TRUE[showGrid]+'</config:config-item>' + LineEnding + AIndent +
' <config:config-item config:name="ShowGrid" config:type="boolean">true</config:config-item>' + LineEnding + AIndent +
// this "ShowGrid" overrides the global setting. But Open/LibreOffice do not allow to change ShowGrid per sheet.
'</config:config-item-map-entry>' + LineEnding;
end;
end;

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

@ -64,6 +64,11 @@ type
procedure TestWriteRead_ODS_ShowGridLines_HideHeaders;
procedure TestWriteRead_ODS_HideGridLines_ShowHeaders;
procedure TestWriteRead_ODS_HideGridLines_HideHeaders;
procedure TestWriteRead_ODS_Panes_HorVert;
procedure TestWriteRead_ODS_Panes_Hor;
procedure TestWriteRead_ODS_Panes_Vert;
procedure TestWriteRead_ODS_Panes_None;
end;
implementation
@ -248,11 +253,14 @@ begin
MyWorksheet := GetWorksheetByName(MyWorkBook, OptionsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
CheckEquals(soHasFrozenPanes in MyWorksheet.Options, true,
CheckEquals(
(AleftPaneWidth > 0) or (ATopPaneHeight > 0),
(soHasFrozenPanes in MyWorksheet.Options)
and ((MyWorksheet.LeftPaneWidth > 0) or (MyWorksheet.TopPaneHeight > 0)),
'Test saved frozen panes mismatch');
CheckEquals(MyWorksheet.LeftPaneWidth, ALeftPaneWidth,
CheckEquals(ALeftPaneWidth, MyWorksheet.LeftPaneWidth,
'Test saved left pane width mismatch');
CheckEquals(MyWorksheet.TopPaneHeight, ATopPaneHeight,
CheckEquals(ATopPaneHeight, MyWorksheet.TopPaneHeight,
'Test save top pane height mismatch');
MyWorkbook.Free;
@ -301,6 +309,28 @@ begin
TestWriteReadPanes(sfExcel8, 0, 0);
end;
{ Tests for ODS frozen panes }
procedure TSpreadWriteReadOptionsTests.TestWriteRead_ODS_Panes_HorVert;
begin
TestWriteReadPanes(sfOpenDocument, 1, 2);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_ODS_Panes_Hor;
begin
TestWriteReadPanes(sfOpenDocument, 1, 0);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_ODS_Panes_Vert;
begin
TestWriteReadPanes(sfOpenDocument, 0, 2);
end;
procedure TSpreadWriteReadOptionsTests.TestWriteRead_ODS_Panes_None;
begin
TestWriteReadPanes(sfOpenDocument, 0, 0);
end;
initialization
RegisterTest(TSpreadWriteReadOptionsTests);

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

@ -47,6 +47,9 @@
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
</BuildModes>
@ -124,6 +127,7 @@
<Unit10>
<Filename Value="optiontests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="optiontests"/>
</Unit10>
<Unit11>
<Filename Value="numformatparsertests.pas"/>
@ -163,6 +167,9 @@
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="6">

6
components/fpspreadsheet/xlsbiff2.pas
View File

@ -1031,7 +1031,11 @@ begin
AStream.WriteByte(b);
{ Panes are frozen? }
b := IfThen(soHasFrozenPanes in ASheet.Options, 1, 0);
b := 0;
if (soHasFrozenPanes in ASheet.Options) and
((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0))
then
b := 1;
AStream.WriteByte(b);
{ Show zero values as zeros, not empty cells }

2
components/fpspreadsheet/xlsbiff5.pas
View File

@ -989,7 +989,7 @@ begin
Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES;
if (soShowHeaders in ASheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS;
if (soHasFrozenPanes in ASheet.Options) then
if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then
Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN;
if (soSelected in ASheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHEET_SELECTED;

2
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1104,7 +1104,7 @@ begin
Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES;
if (soShowHeaders in ASheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS;
if (soHasFrozenPanes in ASheet.Options) then
if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then
Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN;
if (soSelected in ASheet.Options) then
Options := Options or MASK_WINDOW2_OPTION_SHEET_SELECTED;

5
components/fpspreadsheet/xlscommon.pas
View File

@ -1255,6 +1255,9 @@ begin
- Frozen pane: Number of visible rows in top pane(s) }
FWorksheet.TopPaneHeight := WordLEToN(AStream.ReadWord);
if (FWorksheet.LeftPaneWidth = 0) and (FWorksheet.TopPaneHeight = 0) then
FWorksheet.Options := FWorksheet.Options - [soHasFrozenPanes];
{ There's more information which is not supported here:
Offset Size Description
4 2 Index to first visible row in bottom pane(s)
@ -1853,6 +1856,8 @@ var
n: Word;
active_pane: Byte;
begin
if not (soHasFrozenPanes in ASheet.Options) then
exit;
if (ASheet.LeftPaneWidth = 0) and (ASheet.TopPaneHeight = 0) then
exit;