You've already forked lazarus-ccr
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).
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
@ -184,7 +184,7 @@ function fpsVALUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, lazutf8, StrUtils, DateUtils, fpsUtils;
|
||||
Math, lazutf8, DateUtils, fpsUtils;
|
||||
|
||||
|
||||
{ Helpers }
|
||||
|
||||
@ -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 --- }
|
||||
|
||||
|
||||
@ -87,38 +87,43 @@ begin
|
||||
|
||||
// Create test workbook
|
||||
MyWorkbook := TsWorkbook.Create;
|
||||
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
|
||||
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);
|
||||
MyWorkbook.Free;
|
||||
// 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;
|
||||
MyWorkbook.ReadFormulas := true;
|
||||
try
|
||||
MyWorkbook.ReadFormulas := true;
|
||||
|
||||
MyWorkbook.ReadFromFile(TempFile, AFormat);
|
||||
if AFormat = sfExcel2 then
|
||||
MyWorksheet := MyWorkbook.GetFirstWorksheet
|
||||
else
|
||||
MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
|
||||
if MyWorksheet=nil then
|
||||
fail('Error in test code. Failed to get named worksheet');
|
||||
for Row := 0 to MyWorksheet.GetLastRowIndex do
|
||||
begin
|
||||
cell := MyWorksheet.FindCell(Row, 1);
|
||||
if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin
|
||||
actual := MyWorksheet.ReadRPNFormulaAsString(cell);
|
||||
expected := MyWorksheet.ReadAsUTF8Text(Row, 0);
|
||||
CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
MyWorkbook.ReadFromFile(TempFile, AFormat);
|
||||
if AFormat = sfExcel2 then
|
||||
MyWorksheet := MyWorkbook.GetFirstWorksheet
|
||||
else
|
||||
MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
|
||||
if MyWorksheet=nil then
|
||||
fail('Error in test code. Failed to get named worksheet');
|
||||
for Row := 0 to MyWorksheet.GetLastRowIndex do
|
||||
begin
|
||||
cell := MyWorksheet.FindCell(Row, 1);
|
||||
if (cell <> nil) and (Length(cell^.RPNFormulaValue) > 0) then begin
|
||||
actual := MyWorksheet.ReadRPNFormulaAsString(cell);
|
||||
expected := MyWorksheet.ReadAsUTF8Text(Row, 0);
|
||||
CheckEquals(expected, actual, 'Test read formula mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Finalization
|
||||
MyWorkbook.Free;
|
||||
DeleteFile(TempFile);
|
||||
finally
|
||||
MyWorkbook.Free;
|
||||
DeleteFile(TempFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_FormulaStrings;
|
||||
@ -174,94 +179,99 @@ begin
|
||||
|
||||
// Create test workbook
|
||||
MyWorkbook := TsWorkbook.Create;
|
||||
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
|
||||
MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
|
||||
// Calculation of rpn formulas must be activated explicitly!
|
||||
try
|
||||
MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
|
||||
MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
|
||||
// Calculation of rpn formulas must be activated explicitly!
|
||||
|
||||
{ Write out test formulas.
|
||||
This include file creates various rpn formulas and stores the expected
|
||||
results in array "sollValues".
|
||||
The test file contains the text representation in column A, and the
|
||||
formula in column B. }
|
||||
Row := 0;
|
||||
{$I testcases_calcrpnformula.inc}
|
||||
TempFile:=GetTempFileName;
|
||||
MyWorkBook.WriteToFile(TempFile, AFormat, true);
|
||||
MyWorkbook.Free;
|
||||
{ Write out test formulas.
|
||||
This include file creates various rpn formulas and stores the expected
|
||||
results in array "sollValues".
|
||||
The test file contains the text representation in column A, and the
|
||||
formula in column B. }
|
||||
Row := 0;
|
||||
{$I testcases_calcrpnformula.inc}
|
||||
TempFile:=GetTempFileName;
|
||||
MyWorkBook.WriteToFile(TempFile, AFormat, true);
|
||||
finally
|
||||
MyWorkbook.Free;
|
||||
end;
|
||||
|
||||
// Open the workbook
|
||||
MyWorkbook := TsWorkbook.Create;
|
||||
MyWorkbook.ReadFromFile(TempFile, AFormat);
|
||||
if AFormat = sfExcel2 then
|
||||
MyWorksheet := MyWorkbook.GetFirstWorksheet
|
||||
else
|
||||
MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
|
||||
if MyWorksheet=nil then
|
||||
fail('Error in test code. Failed to get named worksheet');
|
||||
try
|
||||
MyWorkbook.ReadFromFile(TempFile, AFormat);
|
||||
if AFormat = sfExcel2 then
|
||||
MyWorksheet := MyWorkbook.GetFirstWorksheet
|
||||
else
|
||||
MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
|
||||
if MyWorksheet=nil then
|
||||
fail('Error in test code. Failed to get named worksheet');
|
||||
|
||||
for Row := 0 to MyWorksheet.GetLastRowIndex do
|
||||
begin
|
||||
formula := MyWorksheet.ReadAsUTF8Text(Row, 0);
|
||||
cell := MyWorksheet.FindCell(Row, 1);
|
||||
if (cell = nil) then
|
||||
fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
|
||||
case cell^.ContentType of
|
||||
cctBool : actual := CreateBoolArg(cell^.BoolValue);
|
||||
cctNumber : actual := CreateNumberArg(cell^.NumberValue);
|
||||
cctError : actual := CreateErrorArg(cell^.ErrorValue);
|
||||
cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue);
|
||||
else fail('ContentType not supported');
|
||||
end;
|
||||
expected := SollValues[row];
|
||||
CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
|
||||
'Test read calculated formula data type mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
for Row := 0 to MyWorksheet.GetLastRowIndex do
|
||||
begin
|
||||
formula := MyWorksheet.ReadAsUTF8Text(Row, 0);
|
||||
cell := MyWorksheet.FindCell(Row, 1);
|
||||
if (cell = nil) then
|
||||
fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
|
||||
case cell^.ContentType of
|
||||
cctBool : actual := CreateBoolArg(cell^.BoolValue);
|
||||
cctNumber : actual := CreateNumberArg(cell^.NumberValue);
|
||||
cctError : actual := CreateErrorArg(cell^.ErrorValue);
|
||||
cctUTF8String : actual := CreateStringArg(cell^.UTF8StringValue);
|
||||
else fail('ContentType not supported');
|
||||
end;
|
||||
expected := SollValues[row];
|
||||
CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
|
||||
'Test read calculated formula data type mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
|
||||
// The now function result is volatile, i.e. changes continuously. The
|
||||
// time for the soll value was created such that we can expect to have
|
||||
// the file value in the same second. Therefore we neglect the milliseconds.
|
||||
if formula = '=NOW()' then begin
|
||||
// Round soll value to seconds
|
||||
DecodeTime(expected.NumberValue, hr,min,sec,msec);
|
||||
expected.NumberValue := EncodeTime(hr, min, sec, 0);
|
||||
// Round formula value to seconds
|
||||
DecodeTime(actual.NumberValue, hr,min,sec,msec);
|
||||
actual.NumberValue := EncodeTime(hr,min,sec,0);
|
||||
// The now function result is volatile, i.e. changes continuously. The
|
||||
// time for the soll value was created such that we can expect to have
|
||||
// the file value in the same second. Therefore we neglect the milliseconds.
|
||||
if formula = '=NOW()' then begin
|
||||
// Round soll value to seconds
|
||||
DecodeTime(expected.NumberValue, hr,min,sec,msec);
|
||||
expected.NumberValue := EncodeTime(hr, min, sec, 0);
|
||||
// Round formula value to seconds
|
||||
DecodeTime(actual.NumberValue, hr,min,sec,msec);
|
||||
actual.NumberValue := EncodeTime(hr,min,sec,0);
|
||||
end;
|
||||
|
||||
case actual.ArgumentType of
|
||||
atBool:
|
||||
CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
atNumber:
|
||||
{$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
|
||||
// FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
|
||||
CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
{$else}
|
||||
// Non-Windows: test without error margin
|
||||
CheckEquals(expected.NumberValue, actual.NumberValue,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
{$endif}
|
||||
atString:
|
||||
CheckEquals(expected.StringValue, actual.StringValue,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
atError:
|
||||
CheckEquals(
|
||||
GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
|
||||
GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
|
||||
'Test read calculated formula error value mismatch, formula ' + formula +
|
||||
', cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
end;
|
||||
end;
|
||||
|
||||
case actual.ArgumentType of
|
||||
atBool:
|
||||
CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
atNumber:
|
||||
{$if (defined(mswindows)) or (FPC_FULLVERSION>=20701)}
|
||||
// FPC 2.6.x and trunk on Windows need this, also FPC trunk on Linux x64
|
||||
CheckEquals(expected.NumberValue, actual.NumberValue, ErrorMargin,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
{$else}
|
||||
// Non-Windows: test without error margin
|
||||
CheckEquals(expected.NumberValue, actual.NumberValue,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
{$endif}
|
||||
atString:
|
||||
CheckEquals(expected.StringValue, actual.StringValue,
|
||||
'Test read calculated formula result mismatch, formula "' + formula +
|
||||
'", cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
atError:
|
||||
CheckEquals(
|
||||
GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
|
||||
GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
|
||||
'Test read calculated formula error value mismatch, formula ' + formula +
|
||||
', cell '+CellNotation(MyWorkSheet,Row,1));
|
||||
end;
|
||||
finally
|
||||
MyWorkbook.Free;
|
||||
DeleteFile(TempFile);
|
||||
end;
|
||||
|
||||
// Finalization
|
||||
MyWorkbook.Free;
|
||||
DeleteFile(TempFile);
|
||||
end;
|
||||
|
||||
procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF2_CalcRPNFormula;
|
||||
|
||||
@ -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);
|
||||
|
||||
Reference in New Issue
Block a user