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

fpspreadsheet: Add font unit test for BIFF2. Currently fails. Need to investigate...

Browse Source 
Fix occasional floating point conversion error in fpsopendocument because of non-initialized format settings.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2963 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-04-24 22:31:01 +00:00
parent c174566e55
commit 887b34383a
6 changed files with 83 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/excel2demo/excel2read.lpr
View File

@ -42,6 +42,7 @@ begin
WriteLn('Row: ', CurCell^.Row, ' Col: ', CurCell^.Col, ' Value: ',
UTF8ToAnsi(MyWorkSheet.ReadAsUTF8Text(CurCell^.Row, CurCell^.Col))
);
WriteLn(MyWorkbook.GetFont(CurCell^.FontIndex).Size-11);
CurCell := MyWorkSheet.GetNextCell();
end;

2
components/fpspreadsheet/examples/excel2demo/excel2write.lpr
View File

@ -27,6 +27,8 @@ begin
// Write some number cells
MyWorksheet.WriteNumber(0, 0, 1.0);
MyWorksheet.WriteFont(0, 0, 'Arial', 11, [fssBold, fssItalic], scBlack);
MyWorksheet.WriteNumber(0, 1, 2.0);
MyWorksheet.WriteNumber(0, 2, 3.0);
MyWorksheet.WriteNumber(0, 3, 4.0);

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -318,6 +318,7 @@ var
Value, Str: String;
lNumber: Double;
begin
FSettings := DefaultFormatSettings;
FSettings.DecimalSeparator:='.';
Value:=GetAttrValue(ACellNode,'office:value');
if UpperCase(Value)='1.#INF' then
@ -344,6 +345,7 @@ var
begin
// Format expects ISO 8601 type date string or
// time string
fmt := DefaultFormatSettings;
fmt.ShortDateFormat:='yyyy-mm-dd';
fmt.DateSeparator:='-';
fmt.LongTimeFormat:='hh:nn:ss';

28
components/fpspreadsheet/tests/colortests.pas
View File

@ -93,12 +93,19 @@ begin
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5));
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
999: begin // Random palette: testing of color replacement
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
for i:=8 to 63 do // first 8 colors cannot be changed
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
end;
{
999: begin // Random palette
SetLength(pal, 64);
for i:=0 to 7 do pal[i] := PALETTE_BIFF8[i];
for i:=0 to 67 do pal[i] := PALETTE_BIFF8[i];
for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
MyWorkbook.UsePalette(@pal[0], 64);
end;
end; }
// else use default palette
end;
@ -175,12 +182,19 @@ begin
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
999: begin
SetLength(pal, 64);
for i:=0 to 7 do pal[i] := PALETTE_BIFF8[i];
for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
MyWorkbook.UsePalette(@pal[0], 64);
999: begin // Random palette: testing of color replacement
MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8));
for i:=8 to 63 do // first 8 colors cannot be changed
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
end;
{
999: begin
SetLength(pal, 64);
for i:=0 to 7 do pal[i] := PALETTE_BIFF8[i];
for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
MyWorkbook.UsePalette(@pal[0], 64);
end;
}
// else use default palette
end;

74
components/fpspreadsheet/tests/fonttests.pas
View File

@ -11,7 +11,7 @@ uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
var
@ -33,11 +33,27 @@ type
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteReadFont(AFontName: String);
procedure TestWriteReadFont(AFormat: TsSpreadsheetFormat; AFontName: String);
published
procedure TestWriteReadFont_Arial;
procedure TestWriteReadFont_TimesNewRoman;
procedure TestWriteReadFont_CourierNew;
{
// BIFF2 test cases
procedure TestWriteReadFontBIFF2_Arial;
procedure TestWriteReadFontBIFF2_TimesNewRoman;
procedure TestWriteReadFontBIFF2_CourierNew;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Currently the BIFF2 tests fail because of a font size mismatch at size 11.
Outside the test suite, however, this error is not reproduced,
and also not when the conflicting case is used in the SollValues alone.
STRANGE...
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
}
// BIFF8 test cases
procedure TestWriteReadFontBIFF8_Arial;
procedure TestWriteReadFontBIFF8_TimesNewRoman;
procedure TestWriteReadFontBIFF8_CourierNew;
end;
implementation
@ -102,7 +118,8 @@ begin
inherited TearDown;
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFontName: String);
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFormat: TsSpreadsheetFormat;
AFontName: String);
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
@ -141,13 +158,16 @@ begin
'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
end;
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkBook.WriteToFile(TempFile, AFormat, true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet);
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet // only 1 sheet for BIFF2
else
MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do
@ -156,8 +176,9 @@ begin
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
font := MyWorkbook.GetFont(MyCell^.FontIndex);
CheckEquals(SollSizes[row], font.Size,
'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col));
if abs(SollSizes[row] - font.Size) > 1e-6 then // safe-guard against rounding errors
CheckEquals(SollSizes[row], font.Size,
'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col));
currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style));
expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col]));
CheckEquals(currValue, expectedValue,
@ -167,21 +188,38 @@ begin
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_Arial;
(*
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF2_Arial;
begin
TestWriteReadFont('Arial');
TestWriteReadFont(sfExcel2, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_TimesNewRoman;
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF2_TimesNewRoman;
begin
TestWriteReadFont('TimesNewRoman');
TestWriteReadFont(sfExcel2, 'TimesNewRoman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_CourierNew;
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF2_CourierNew;
begin
TestWriteReadFont('CourierNew');
TestWriteReadFont(sfExcel2, 'CourierNew');
end;
*)
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF8_Arial;
begin
TestWriteReadFont(sfExcel8, 'Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF8_TimesNewRoman;
begin
TestWriteReadFont(sfExcel8, 'TimesNewRoman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFontBIFF8_CourierNew;
begin
TestWriteReadFont(sfExcel8, 'CourierNew');
end;
initialization
RegisterTest(TSpreadWriteReadFontTests);

2
components/fpspreadsheet/xlsbiff2.pas
View File

@ -868,7 +868,7 @@ begin
FFont := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
lHeight := WordLEToN(AStream.ReadWord);
FFont.Size := lHeight/20;
{ Option flags }