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

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

components/fpspreadsheet/examples/excel2demo/excel2read.lpr

@@ -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;
 

components/fpspreadsheet/examples/excel2demo/excel2write.lpr

@@ -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);

components/fpspreadsheet/fpsopendocument.pas

@@ -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';

components/fpspreadsheet/tests/colortests.pas

@@ -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  // 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;
 

components/fpspreadsheet/tests/fonttests.pas

@@ -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,12 +158,15 @@ 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);
+  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');
@@ -156,6 +176,7 @@ begin
       if MyCell = nil then
         fail('Error in test code. Failed to get cell.');
       font := MyWorkbook.GetFont(MyCell^.FontIndex);
+      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));
@@ -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);

components/fpspreadsheet/xlsbiff2.pas

@@ -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 }