fpspreadsheet: Make sure that Excel's system colors are kept when colors are added to a palette. Fix BIFF 2 font color mismatch in unit test. All green again.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3471 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpspreadsheet.pas

@@ -1203,6 +1203,32 @@ resourcestring
   lpErrArgError = '#N/A';
   lpErrFormulaNotSupported = '<FORMULA?>';
 
+const
+  { These are reserved system colors by Microsoft
+
+  0x0040 Default foreground color - window text color in the sheet display.
+  0x0041 Default background color - window background color in the sheet display and is the default background color for a cell.
+  0x004D Default chart foreground color - window text color in the chart display.
+  0x004E Default chart background color - window background color in the chart display.
+  0x004F Chart neutral color which is black, an RGB value of (0,0,0).
+  0x0051 ToolTip text color - automatic font color for comments.
+  0x7FFF Font automatic color - window text color. }
+  DEF_FOREGROUND_COLOR = $0040;
+  DEF_BACKGROUND_COLOR = $0041;
+  DEF_CHART_FOREGROUND_COLOR = $004D;
+  DEF_CHART_BACKGROUND_COLOR = $004E;
+  DEF_CHART_NEUTRAL_COLOR = $004F;
+  DEF_TOOLTIP_TEXT_COLOR = $0051;
+  DEF_FONT_AUTOMATIC_COLOR = $7FFF;
+
+  DEF_FOREGROUND_COLORVALUE = $000000;
+  DEF_BACKGROUND_COLORVALUE = $FFFFFF;
+  DEF_CHART_FOREGROUND_COLORVALUE = $000000;
+  DEF_CHART_BACKGROUND_COLORVALUE = $FFFFFF;
+  DEF_CHART_NEUTRAL_COLORVALUE = $FFFFFF;
+  DEF_TOOLTIP_TEXT_COLORVALUE = $000000;
+  DEF_FONT_AUTOMATIC_COLORVALUE = $000000;
+
 var
   {@@ RGB colors RGB in "big-endian" notation (red at left). The values are inverted
     at initialization to be little-endian at run-time!
@@ -5452,17 +5478,74 @@ end;
   @return  Index of the new (or already existing) color item
 }
 function TsWorkbook.AddColorToPalette(AColorValue: TsColorValue): TsColor;
+var
+  n: Integer;
 begin
+  n := Length(FPalette);
+
   // Look look for the color. Is it already in the existing palette?
-  if Length(FPalette) > 0 then
+  if n > 0 then
-    for Result := 0 to Length(FPalette)-1 do
+    for Result := 0 to n-1 do
       if FPalette[Result] = AColorValue then
         exit;
 
   // No --> Add it to the palette.
-  Result := Length(FPalette);
+
-  SetLength(FPalette, Result+1);
+  // Do not overwrite Excel's built-in system colors
-  FPalette[Result] := AColorValue;
+  case n of
+    DEF_FOREGROUND_COLOR:
+      begin
+        SetLength(FPalette, n+3);
+        FPalette[n] := DEF_FOREGROUND_COLORVALUE;
+        FPalette[n+1] := DEF_BACKGROUND_COLORVALUE;
+        FPalette[n+2] := AColorValue;
+      end;
+    DEF_BACKGROUND_COLOR:
+      begin
+        SetLength(FPalette, n+2);
+        FPalette[n] := DEF_BACKGROUND_COLORVALUE;
+        FPalette[n+1] := AColorValue;
+      end;
+    DEF_CHART_FOREGROUND_COLOR:
+      begin
+        SetLength(FPalette, n+4);
+        FPalette[n] := DEF_CHART_FOREGROUND_COLORVALUE;
+        FPalette[n+1] := DEF_CHART_BACKGROUND_COLORVALUE;
+        FPalette[n+2] := DEF_CHART_NEUTRAL_COLORVALUE;
+        FPalette[n+3] := AColorValue;
+      end;
+    DEF_CHART_BACKGROUND_COLOR:
+      begin
+        SetLength(FPalette, n+3);
+        FPalette[n] := DEF_CHART_BACKGROUND_COLORVALUE;
+        FPalette[n+1] := DEF_CHART_NEUTRAL_COLORVALUE;
+        FPalette[n+2] := AColorValue;
+      end;
+    DEF_CHART_NEUTRAL_COLOR:
+      begin
+        SetLength(FPalette, n+2);
+        FPalette[n] := DEF_CHART_NEUTRAL_COLORVALUE;
+        FPalette[n+1] := AColorValue;
+      end;
+    DEF_TOOLTIP_TEXT_COLOR:
+      begin
+        SetLength(FPalette, n+2);
+        FPalette[n] := DEF_TOOLTIP_TEXT_COLORVALUE;
+        FPalette[n+1] := AColorValue;
+      end;
+    DEF_FONT_AUTOMATIC_COLOR:
+      begin
+        SetLength(FPalette, n+2);
+        FPalette[n] := DEF_FONT_AUTOMATIC_COLORVALUE;
+        FPalette[n+1] := AColorValue;
+      end;
+    else
+      begin
+        SetLength(FPalette, n+1);
+        FPalette[n] := AColorValue;
+      end;
+  end;
+  Result := Length(FPalette) - 1;
 end;
 
 {@@
@@ -5600,13 +5683,36 @@ end;
 }
 function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): TsColorValue;
 begin
-  if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
+  if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
+  begin
     if ((FPalette = nil) or (Length(FPalette) = 0)) then
       Result := DEFAULT_PALETTE[AColorIndex]
     else
       Result := FPalette[AColorIndex];
-  end else
+  end
+  else
     Result := $000000;  // "black" as default
+  {
+
+  case AColorIndex of
+    $0040: Result := DEF_FOREGROUND_COLORVALUE;
+    $0041: Result := DEF_BACKGROUND_COLORVALUE;
+    $004D: Result := DEF_CHART_FOREGROUND_COLORVALUE;
+    $004E: Result := DEF_CHART_BACKGROUND_COLORVALUE;
+    $004F: Result := DEF_CHART_NEUTRAL_COLORVALUE;
+    $0051: Result := DEF_TOOLTIP_TEXT_COLORVALUE;
+    $7FFF: Result := DEF_FONT_AUTOMATIC_COLORVALUE;
+    else   if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
+           begin
+             if ((FPalette = nil) or (Length(FPalette) = 0)) then
+               Result := DEFAULT_PALETTE[AColorIndex]
+             else
+               Result := FPalette[AColorIndex];
+           end
+           else
+             Result := $000000;  // "black" as default
+  end;
+  }
 end;
 
 {@@
@@ -5677,6 +5783,9 @@ procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
 var
   i: Integer;
 begin
+  if APaletteCount > 64 then
+    raise Exception.Create('Due to Excel-compatibility, palettes cannot have more then 64 colors.');
+
  {$IFOPT R+}
   {$DEFINE RNGCHECK}
  {$ENDIF}

components/fpspreadsheet/tests/colortests.pas

@@ -266,9 +266,16 @@ begin
       if MyCell = nil then
         fail('Error in test code. Failed to get cell.');
       color := TsColor(row);
+      expectedRGB := pal[color];
       colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
       currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
-      expectedRGB := pal[color]; //MyWorkbook.GetPaletteColor(color);
+
+      // Excel2 cannot write the entire palette. The writer had called "FixColor".
+      // We simulate that here to get the color correct.
+      if (AFormat = sfExcel2) and (color >= BIFF2_MAX_PALETTE_SIZE) then begin
+        color := MyWorkbook.FindClosestColor(expectedRGB, BIFF2_MAX_PALETTE_SIZE);
+        expectedRGB := MyWorkbook.GetPaletteColor(color);
+      end;
       CheckEquals(expectedRGB, currentRGB,
         'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
     end;

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -48,12 +48,10 @@
       <Unit1>
         <Filename Value="datetests.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="datetests"/>
       </Unit1>
       <Unit2>
         <Filename Value="stringtests.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="stringtests"/>
       </Unit2>
       <Unit3>
         <Filename Value="numberstests.pas"/>
@@ -72,7 +70,6 @@
       <Unit6>
         <Filename Value="internaltests.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="internaltests"/>
       </Unit6>
       <Unit7>
         <Filename Value="formattests.pas"/>
@@ -99,6 +96,7 @@
       <Unit12>
         <Filename Value="rpnformulaunit.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="rpnFormulaUnit"/>
       </Unit12>
       <Unit13>
         <Filename Value="formulatests.pas"/>
@@ -108,6 +106,7 @@
       <Unit14>
         <Filename Value="emptycelltests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="emptycelltests"/>
       </Unit14>
       <Unit15>
         <Filename Value="errortests.pas"/>

components/fpspreadsheet/xlsbiff2.pas

@@ -36,6 +36,10 @@ uses
   Classes, SysUtils,
   fpspreadsheet, xlscommon, fpsutils, lconvencoding;
 
+const
+  BIFF2_MAX_PALETTE_SIZE = 8;
+  // There are more colors but they do not seem to be controlled by a palette.
+
 type
 
   { TsBIFF2NumFormatList }
@@ -143,6 +147,8 @@ var
     $00FFFF   // $07: cyan
   );
 
+  // However, it looks as if BIFF2 can handle more colors, at least 16 are
+  // compatible with the other formats.
 
 implementation
 
@@ -325,7 +331,7 @@ end;
 constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
-  FLimitations.MaxPaletteSize := 16;
+  FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
 end;
 
 procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
@@ -936,7 +942,7 @@ end;
 constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
-  FLimitations.MaxPaletteSize := 16;
+  FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
 end;
 
 { Creates the correct version of the number format list.

components/fpspreadsheet/xlscommon.pas

@@ -1815,7 +1815,6 @@ var
   rgb: TsColorValue;
 begin
   if AColor >= Limitations.MaxPaletteSize then begin
-//  if AColor >= 64 then begin
     rgb := Workbook.GetPaletteColor(AColor);
     Result := Workbook.FindClosestColor(rgb, FLimitations.MaxPaletteSize);
   end else