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

fpspreadsheet: Add test case for copy format. Fix default vertical text alignment issue of biff5 and biff8.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3817 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-12-01 16:50:00 +00:00
parent 4f37004628
commit 794f556efe
7 changed files with 320 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1321,8 +1321,8 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
function SameCellBorders(ACell1, ACell2: PCell): Boolean;
procedure InitCell(out ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell); overload;
procedure InitCell(var ACell: TCell); overload;
procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell); overload;
function HasFormula(ACell: PCell): Boolean;
@ -1573,12 +1573,13 @@ end;
Initalizes a new cell.
@return New cell record
-------------------------------------------------------------------------------}
procedure InitCell(out ACell: TCell);
procedure InitCell(var ACell: TCell);
begin
ACell.FormulaValue := '';
ACell.UTF8StringValue := '';
ACell.NumberFormatStr := '';
FillChar(ACell, SizeOf(ACell), 0);
ACell.BorderStyles := DEFAULT_BORDERSTYLES;
end;
{@@ ----------------------------------------------------------------------------
@ -1589,7 +1590,7 @@ end;
@param ACol Column index of the new cell
@return New cell record with row and column fields preset to passed values.
-------------------------------------------------------------------------------}
procedure InitCell(ARow, ACol: Cardinal; out ACell: TCell);
procedure InitCell(ARow, ACol: Cardinal; var ACell: TCell);
begin
InitCell(ACell);
ACell.Row := ARow;
@ -2287,14 +2288,9 @@ begin
if (Result = nil) then
begin
New(Result);
FillChar(Result^, SizeOf(TCell), #0);
Result^.Row := ARow;
Result^.Col := ACol;
Result^.ContentType := cctEmpty;
Result^.BorderStyles := DEFAULT_BORDERSTYLES;
InitCell(ARow, ACol, Result^);
Cells.Add(Result);
if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true)
else FFirstColIndex := Min(FFirstColIndex, ACol);
if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true)

325
components/fpspreadsheet/tests/copytests.pas
View File

@ -14,7 +14,7 @@ uses
testsutility;
var
SourceCells: Array[0..6] of TCell;
SourceCells: Array[0..9] of TCell;
procedure InitCopyData;
@ -32,48 +32,68 @@ type
published
procedure Test_CopyValuesToEmptyCells;
// procedure Test_Copy_Format;
// procedure Test_Copy_Formula;
procedure Test_CopyValuesToOccupiedCells;
procedure Test_CopyFormatsToEmptyCells;
procedure Test_CopyFormatsToOccupiedCells;
end;
implementation
uses
TypInfo, Math, fpsutils;
TypInfo, fpsutils;
const
CopyTestSheet = 'Copy';
function InitNumber(ANumber: Double): TCell;
function InitNumber(ANumber: Double; ABkColor: TsColor): TCell;
begin
InitCell(Result);
Result.ContentType := cctNumber;
Result.Numbervalue := ANumber;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end;
end;
function InitString(AString: String): TCell;
function InitString(AString: String; ABkColor: TsColor): TCell;
begin
InitCell(Result);
Result.ContentType := cctUTF8String;
Result.UTF8StringValue := AString;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end;
end;
function InitFormula(AFormula: String; ANumberResult: Double): TCell;
function InitFormula(AFormula: String; ANumberResult: Double; ABkColor: TsColor): TCell;
begin
InitCell(Result);
Result.FormulaValue := AFormula;
Result.NumberValue := ANumberResult;
Result.ContentType := cctNumber;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end;
end;
procedure InitCopyData;
begin
SourceCells[0] := InitNumber(1.0); // will be in A1
SourceCells[1] := InitNumber(2.0);
SourceCells[2] := InitNumber(3.0);
SourceCells[3] := InitString('Lazarus');
SourceCells[4] := InitFormula('A1+1', 2.0);
InitCell(SourceCells[5]); // empty but existing
SourceCells[0] := InitNumber(1.0, scTransparent); // will be in A1
SourceCells[1] := InitNumber(2.0, scTransparent);
SourceCells[2] := InitNumber(3.0, scYellow);
SourceCells[3] := InitString('Lazarus', scRed);
SourceCells[4] := InitFormula('A1+1', 2.0, scTransparent);
SourceCells[5] := InitFormula('$A1+1', 2.0, scTransparent);
SourceCells[6] := InitFormula('A$1+1', 2.0, scTransparent);
SourceCells[7] := InitFormula('$A$1+1', 2.0, scGray);
InitCell(SourceCells[8]); // empty but existing
end;
@ -112,28 +132,60 @@ begin
MyWorkSheet:= MyWorkBook.AddWorksheet(CopyTestSheet);
// Create two identical columns A and B
for row := 0 to High(SourceCells) do
for col := 0 to 1 do
// Prepare the worksheet in which cells are copied:
// Store the SourceCells to column A and B; in B shifted down by 1 cell
{ A B
1 1.0
2 2.0 1.0
3 3.0 (yellow) 2.0
4 Lazarus (red) 3.0
5 A1+1 Lazarus
6 $A1+1 A1+1
7 A$1+1 $A1+1
8 $A$1+1 (gray) A$1+1
9 (empty) $A$1+1 (gray)
10 (empty)
}
for col := 0 to 1 do
for row := 0 to High(SourceCells) do
begin
// Why is there a row index of "row + col" below? The first column has the
// data starting at the top, in cell A1. In the second column each row
// index is incremented by 1, i.e. the data are shifted down by 1 cell.
case SourceCells[row].ContentType of
cctNumber:
cell := MyWorksheet.WriteNumber(row, col, SourceCells[row].NumberValue);
cell := MyWorksheet.WriteNumber(row+col, col, SourceCells[row].NumberValue);
cctUTF8String:
cell := Myworksheet.WriteUTF8Text(row, col, SourceCells[row].UTF8StringValue);
cell := Myworksheet.WriteUTF8Text(row+col, col, SourceCells[row].UTF8StringValue);
cctEmpty:
cell := MyWorksheet.WriteBlank(row, col);
cell := MyWorksheet.WriteBlank(row+col, col);
end;
if SourceCells[row].FormulaValue <> '' then
Myworksheet.WriteFormula(row, col, SourceCells[row].FormulaValue);
Myworksheet.WriteFormula(row+col, col, SourceCells[row].FormulaValue);
if (uffBackgroundColor in SourceCells[row].UsedFormattingFields) then
MyWorksheet.WriteBackgroundColor(cell, SourceCells[row].BackgroundColor);
end;
MyWorksheet.CalcFormulas;
// Now perform the "copy" operations
case ATestKind of
1: // copy the source cell values to the empty column C
for row := 0 to High(SourceCells) do
Myworksheet.CopyValue(MyWorksheet.FindCell(row, 0), row, 2);
1, 2:
// copy the source cell VALUES to the empty column C (ATestKind = 1)
// or occupied column B (ATestKind = 2)
begin
if ATestKind = 1 then col := 2 else col := 1;
for row := 0 to High(SourceCells) do
Myworksheet.CopyValue(MyWorksheet.FindCell(row, 0), row, col);
end;
3, 4:
// copy the source cell FORMATS to the empty column C (ATestKind = 1)
// or occupied column B (ATestKind = 2)
begin
if ATestKind = 1 then col := 2 else col := 1;
for row := 0 to High(SourceCells) do
MyWorksheet.CopyFormat(MyWorksheet.FindCell(row, 0), row, col);
end;
end;
// Write to file
@ -150,41 +202,186 @@ begin
MyWorksheet := MyWorkbook.GetFirstWorksheet;
case ATestKind of
1: // Copied values in first colum to empty third column
// The formula cell should contain the result of A1+1 (only value copied)
begin
col := 2;
// Number cells
for row := 0 to High(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col));
1, 2:
// Copied VALUES in first colum to empty third column (ATestKind = 1) or
// occuopied second column (ATestKind = 2)
// The formula cell should contain the result of A1+1 (only value copied)
begin
if ATestKind = 1 then col := 2 else col := 1;
for row := 0 to Length(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
case SourceCells[row].ContentType of
cctNumber:
CheckEquals(
SourceCells[row].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col));
cctUTF8String:
CheckEquals(
SourceCells[row].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col));
end;
if row < Length(SourceCells) then
begin
// Check content type
if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col)
);
if HasFormula(@SourceCells[row]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col));
// Check values
case SourceCells[row].ContentType of
cctNumber:
CheckEquals(
SourceCells[row].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
cctUTF8String:
CheckEquals(
SourceCells[row].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check formula results
if HasFormula(@SourceCells[row]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check format: it should not be changed when copying only values
case ATestKind of
1: // Copy to empty column --> no formatting
CheckEquals(
true, // true = "the cell has default formatting"
(cell = nil) or (cell^.UsedFormattingFields = []),
'Default format mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
2: // Copy to occupied column --> format like source, but shifted down 1 cvell
if row = 0 then // this cell should not be formatted
CheckEquals(
true,
cell^.UsedFormattingFields = [],
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
)
else
begin
CheckEquals(
true,
SourceCells[row-1].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row-1].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
end;
{ ------------------------------------------------ }
3: // FORMATs copied from first column to empty third column
begin
col := 2;
for row :=0 to Length(SourceCells)-1 do
begin
cell := MyWorksheet.FindCell(row, col);
// There should not be any content because the column was empty and
// we had copied only formats
CheckEquals(
true, // true = "the cell has no content"
(cell = nil) or (cell^.ContentType = cctEmpty),
'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
// Check the format: it should be identical to that in column A
if cell <> nil then
begin
CheckEquals(
true,
SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
{ ---------------------------- }
4: // FORMATs copied from 1st to second column.
begin
col := 1;
// Check values: they should be unchanged, i.e. identical to column A,
// but there is a vertical offset by 1 cell
cell := MyWorksheet.FindCell(0, col);
CheckEquals(
true, // true = "the cell has no content"
(cell = nil) or (cell^.ContentType = cctEmpty),
'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
for row := 1 to Length(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
// Check content type
if (SourceCells[row-1].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row-1].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col)
);
// Check values
case SourceCells[row-1].ContentType of
cctNumber:
CheckEquals(
SourceCells[row-1].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
cctUTF8String:
CheckEquals(
SourceCells[row-1].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check formula results
if HasFormula(@SourceCells[row-1]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Now check formatting - it should be equal to first column
for row := 0 to Length(SourceCells)-1 do
begin
cell := MyWorksheet.FindCell(row, col);
CheckEquals(
true,
SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
end;
end;
finally
@ -200,6 +397,24 @@ begin
Test_Copy(1);
end;
{ Copy given cell values to occupied cells }
procedure TSpreadCopyTests.Test_CopyValuesToOccupiedCells;
begin
Test_Copy(2);
end;
{ Copy given cell formats to empty cells }
procedure TSpreadCopyTests.Test_CopyFormatsToEmptyCells;
begin
Test_Copy(3);
end;
{ Copy given cell formats to occupied cells }
procedure TSpreadCopyTests.Test_CopyFormatsToOccupiedCells;
begin
Test_Copy(4);
end;
initialization
RegisterTest(TSpreadCopyTests);

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

@ -639,8 +639,8 @@ begin
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
vertAlign := TsVertAlignment(row);
if (vertAlign = vaDefault) and (AFormat in [sfExcel5, sfExcel8]) then
vertAlign := vaBottom;
if (vertAlign = vaBottom) and (AFormat in [sfExcel5, sfExcel8]) then
vertAlign := vaDefault;
CheckEquals(
GetEnumName(TypeInfo(TsVertAlignment), Integer(vertAlign)),
GetEnumName(TypeInfo(TsVertAlignment), Integer(MyCell^.VertAlignment)),

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

@ -48,6 +48,7 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -60,6 +61,7 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
@ -68,6 +70,7 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -106,6 +109,7 @@
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>
@ -114,11 +118,11 @@
<Unit17>
<Filename Value="insertdeletetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="insertdeletetests"/>
</Unit17>
<Unit18>
<Filename Value="celltypetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="celltypetests"/>
</Unit18>
<Unit19>
<Filename Value="sortingtests.pas"/>

22
components/fpspreadsheet/xlsbiff5.pas
View File

@ -1380,7 +1380,15 @@ begin
// Vertical text alignment
b := (xf.Align_TextBreak AND MASK_XF_VERT_ALIGN) shr 4;
if (b + 1 <= ord(high(TsVertAlignment))) then
lData.VertAlignment := tsVertAlignment(b + 1) // + 1 due to vaDefault
begin
lData.VertAlignment := tsVertAlignment(b + 1); // + 1 due to vaDefault
// Unfortunately BIFF does not provide a "default" vertical alignment code.
// Without the following correction "non-formatted" cells would always have
// the uffVertAlign FormattingField set which contradicts the statement of
// not being formatted.
if lData.VertAlignment = vaBottom then
lData.VertAlignment := vaDefault;
end
else
lData.VertAlignment := vaDefault;
@ -1403,22 +1411,26 @@ begin
// The case of "no line" is not included in the TsLineStyle enumeration.
// --> correct by subtracting 1!
dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbSouth);
lData.BorderStyles[cbSouth].LineStyle := TsLineStyle(dw shr 22 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_LEFT;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbWest);
lData.BorderStyles[cbWest].LineStyle := TsLineStyle(dw shr 3 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_RIGHT;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbEast);
lData.BorderStyles[cbEast].LineStyle := TsLineStyle(dw shr 6 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_TOP;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbNorth);
lData.BorderStyles[cbNorth].LineStyle := TsLineStyle(dw - 1);
end;

25
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1966,7 +1966,15 @@ begin
// Vertical text alignment
b := (xf.Align_TextBreak AND MASK_XF_VERT_ALIGN) shr 4;
if (b + 1 <= ord(high(TsVertAlignment))) then
lData.VertAlignment := tsVertAlignment(b + 1) // + 1 due to vaDefault
begin
lData.VertAlignment := tsVertAlignment(b + 1); // + 1 due to vaDefault
// Unfortunately BIFF does not provide a "default" vertical alignment code.
// Without the following correction "non-formatted" cells would always have
// the uffVertAlign FormattingField set which contradicts the statement of
// not being formatted.
if lData.VertAlignment = vaBottom then
lData.VertAlignment := vaDefault;
end
else
lData.VertAlignment := vaDefault;
@ -1988,27 +1996,32 @@ begin
// the 4 masked bits encode the line style of the border line. 0 = no line
dw := xf.Border_Background_1 and MASK_XF_BORDER_LEFT;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbWest);
lData.BorderStyles[cbWest].LineStyle := FixLineStyle(dw);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_RIGHT;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbEast);
lData.BorderStyles[cbEast].LineStyle := FixLineStyle(dw shr 4);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_TOP;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbNorth);
lData.BorderStyles[cbNorth].LineStyle := FixLineStyle(dw shr 8);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM;
if dw <> 0 then begin
if dw <> 0 then
begin
Include(lData.Borders, cbSouth);
lData.BorderStyles[cbSouth].LineStyle := FixLineStyle(dw shr 12);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_DIAGONAL;
if dw <> 0 then begin
if dw <> 0 then
begin
lData.BorderStyles[cbDiagUp].LineStyle := FixLineStyle(dw shr 21);
lData.BorderStyles[cbDiagDown].LineStyle := lData.BorderStyles[cbDiagUp].LineStyle;
if xf.Border_Background_1 and MASK_XF_BORDER_SHOW_DIAGONAL_UP <> 0 then

1
components/fpspreadsheet/xlscommon.pas
View File

@ -321,7 +321,6 @@ type
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream);
function GetLastColIndex(AWorksheet: TsWorksheet): Word;
// function FormulaElementKindToExcelTokenID(AElementKind: TFEKind; out ASecondaryID: Word): Word;
// Helper function for writing a string with 8-bit length }
function WriteString_8BitLen(AStream: TStream; AString: String): Integer; virtual;