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

fpspreadsheet: Support for column widths and row heights of xlsx reader. Extend unit tests --> passed. Add "debug with heaptrc" build mode to spreadtestgui (--> there is an unfixed memory leak in fpsfunc).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3418 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-03 21:21:31 +00:00
parent f10b177f03
commit a7c1405be0
4 changed files with 185 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/fpsfunc.pas
View File

@ -184,7 +184,7 @@ function fpsVALUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
implementation
uses
Math, lazutf8, StrUtils, DateUtils, fpsUtils;
Math, lazutf8, DateUtils, fpsUtils;
{ Helpers }

13
components/fpspreadsheet/tests/formattests.pas
View File

@ -122,6 +122,8 @@ type
procedure TestWriteRead_OOXML_Alignment;
procedure TestWriteRead_OOXML_Border;
procedure TestWriteRead_OOXML_BorderStyles;
procedure TestWriteRead_OOXML_ColWidths;
procedure TestWriteRead_OOXML_RowHeights;
procedure TestWriteRead_OOXML_DateTimeFormats;
procedure TestWriteRead_OOXML_NumberFormats;
procedure TestWriteRead_OOXML_TextRotation;
@ -934,6 +936,12 @@ begin
TestWriteReadColWidths(sfOpenDocument);
end;
procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_ColWidths;
begin
TestWriteReadColWidths(sfOOXML);
end;
{ --- Row height tests --- }
procedure TSpreadWriteReadFormatTests.TestWriteReadRowHeights(AFormat: TsSpreadsheetFormat);
@ -1005,6 +1013,11 @@ begin
TestWriteReadRowHeights(sfOpenDocument);
end;
procedure TSpreadWriteReadFormatTests.TestWriteRead_OOXML_RowHeights;
begin
TestWriteReadRowHeights(sfOOXML);
end;
{ --- Text rotation tests --- }

14
components/fpspreadsheet/tests/formulatests.pas
View File

@ -87,16 +87,20 @@ begin
// Create test workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
// Write out all test formulas
// All formulas are in column B
WriteRPNFormulaSamples(MyWorksheet, AFormat, true);
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFormulas := true;
MyWorkbook.ReadFromFile(TempFile, AFormat);
@ -116,9 +120,10 @@ begin
end;
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_FormulaStrings;
@ -174,6 +179,7 @@ begin
// Create test workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
// Calculation of rpn formulas must be activated explicitly!
@ -187,10 +193,13 @@ begin
{$I testcases_calcrpnformula.inc}
TempFile:=GetTempFileName;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the workbook
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -259,9 +268,10 @@ begin
end;
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_CalcRPNFormula;

57
components/fpspreadsheet/xlsxooxml.pas
View File

@ -68,6 +68,7 @@ type
procedure ReadBorders(ANode: TDOMNode);
procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadCellXfs(ANode: TDOMNode);
procedure ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadDateMode(ANode: TDOMNode);
procedure ReadFileVersion(ANode: TDOMNode);
procedure ReadFills(ANode: TDOMNode);
@ -75,6 +76,7 @@ type
procedure ReadFonts(ANode: TDOMNode);
procedure ReadNumFormats(ANode: TDOMNode);
procedure ReadPalette(ANode: TDOMNode);
procedure ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet);
procedure ReadSharedStrings(ANode: TDOMNode);
procedure ReadSheetList(ANode: TDOMNode; AList: TStrings);
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
@ -688,6 +690,35 @@ begin
end;
end;
procedure TsSpreadOOXMLReader.ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet);
var
colNode: TDOMNode;
col, col1, col2: Cardinal;
w: Double;
s: String;
begin
if ANode = nil then
exit;
colNode := ANode.FirstChild;
while Assigned(colNode) do begin
s := GetAttrValue(colNode, 'customWidth');
if s = '1' then begin
s := GetAttrValue(colNode, 'min');
if s <> '' then col1 := StrToInt(s)-1 else col1 := 0;
s := GetAttrValue(colNode, 'max');
if s <> '' then col2 := StrToInt(s)-1 else col2 := col1;
s := GetAttrValue(colNode, 'width');
if s <> '' then begin
w := StrToFloat(s, FPointSeparatorSettings);
for col := col1 to col2 do
FWorksheet.WriteColWidth(col, w);
end;
end;
colNode := colNode.NextSibling;
end;
end;
procedure TsSpreadOOXMLReader.ReadDateMode(ANode: TDOMNode);
var
s: String;
@ -929,6 +960,30 @@ begin
FWorkbook.UsePalette(@pal[0], n);
end;
procedure TsSpreadOOXMLReader.ReadRowHeight(ANode: TDOMNode; AWorksheet: TsWorksheet);
var
s: String;
ht: Single;
r: Cardinal;
row: PRow;
begin
if ANode = nil then
exit;
s := GetAttrValue(ANode, 'customHeight');
if s = '1' then begin
s := GetAttrValue(ANode, 'r');
r := StrToInt(s) - 1;
s := GetAttrValue(ANode, 'ht');
ht := StrToFloat(s, FPointSeparatorSettings); // seems to be in "Points"
row := FWorksheet.GetRow(r);
row^.Height := ht / FWorkbook.GetDefaultFontSize;
if row^.Height > ROW_HEIGHT_CORRECTION then
row^.Height := row^.Height - ROW_HEIGHT_CORRECTION
else
row^.Height := 0;
end;
end;
procedure TsSpreadOOXMLReader.ReadSharedStrings(ANode: TDOMNode);
var
valuenode: TDOMNode;
@ -967,6 +1022,7 @@ begin
rownode := ANode.FirstChild;
while Assigned(rownode) do begin
if rownode.NodeName = 'row' then begin
ReadRowHeight(rownode, AWorksheet);
cellnode := rownode.FirstChild;
while Assigned(cellnode) do begin
if cellnode.NodeName = 'c' then
@ -1068,6 +1124,7 @@ begin
FWorksheet := AData.AddWorksheet(SheetList[i]);
ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet);
ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet);
FreeAndNil(Doc);