fpspreadsheet: Fix biff format writing non-editable palette indexes to file (Excel cannot edit the cells any more - see http://forum.lazarus.freepascal.org/index.php/topic,36903.0.html)

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

components/fpspreadsheet/source/common/fpspalette.pas

@@ -29,7 +29,7 @@ type
     procedure SetColor(AIndex: Integer; AColor: TsColor);
   public
     constructor Create;
-    procedure AddBuiltinColors; virtual;
+    procedure AddBuiltinColors(EditableSet: Boolean = false); virtual;
     function AddColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
     procedure AddExcelColors;
     function AddUniqueColor(AColor: TsColor; ABigEndian: Boolean = false): Integer;
@@ -37,7 +37,8 @@ type
     procedure CollectFromWorkbook(AWorkbook: TsWorkbook);
     function ColorUsedInWorkbook(APaletteIndex: Integer; AWorkbook: TsWorkbook): Boolean;
     function FindClosestColorIndex(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer;
-    function FindColor(AColor: TsColor; AMaxPaletteCount: Integer = -1): Integer;
+    function FindColor(AColor: TsColor; AMaxPaletteCount: Integer = -1;
+      AStartIndex: Integer = 0): Integer;
     function Count: Integer;
     procedure Trim(AMaxSize: Integer);
     procedure UseColors(const AColors: array of TsColor; ABigEndian: Boolean = false);
@@ -101,8 +102,9 @@ end;
 
 {@@ ----------------------------------------------------------------------------
   Adds the built-in colors
+  NOTE: These colors cannot be edited by Excel.
 -------------------------------------------------------------------------------}
-procedure TsPalette.AddBuiltinColors;
+procedure TsPalette.AddBuiltinColors(EditableSet: Boolean = false);
 begin
   AddColor(scBlack);   // 0
   AddColor(scWhite);   // 1
@@ -112,6 +114,18 @@ begin
   AddColor(scYellow);  // 5
   AddColor(scMagenta); // 6
   AddColor(scCyan);    // 7
+
+  if EditableSet then
+  begin
+    AddColor($000000, true);   // $08: EGA black
+    AddColor($FFFFFF, true);   // $09: EGA white
+    AddColor($FF0000, true);   // $0A: EGA red
+    AddColor($00FF00, true);   // $0B: EGA green
+    AddColor($0000FF, true);   // $0C: EGA blue
+    AddColor($FFFF00, true);   // $0D: EGA yellow
+    AddColor($FF00FF, true);   // $0E: EGA magenta
+    AddColor($00FFFF, true);   // $0F: EGA cyan
+  end;
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -340,13 +354,13 @@ end;
   @return  Palette index of AColor
 -------------------------------------------------------------------------------}
 function TsPalette.FindColor(AColor: TsColor;
-  AMaxPaletteCount: Integer = -1): Integer;
+  AMaxPaletteCount: Integer = -1; AStartIndex: Integer = 0): Integer;
 var
   n: Integer;
 begin
   n := Length(FColors);
   if AMaxPaletteCount > n then n := AMaxPaletteCount;
-  for Result := 0 to n - 1 do
+  for Result := AStartIndex to n - 1 do
     if GetColor(Result) = AColor then
       exit;
   Result := -1;

components/fpspreadsheet/source/common/xlsbiff8.pas

@@ -136,6 +136,7 @@ type
   protected
     function GetPrintOptions: Word; override;
     procedure InternalWriteToStream(AStream: TStream);
+    procedure PopulatePalette; override;
 
     { Record writing methods }
     procedure WriteBOF(AStream: TStream; ADataType: Word);
@@ -2224,6 +2225,12 @@ begin
   SetLength(sheetPos, 0);
 end;
 
+procedure TsSpreadBIFF8Writer.PopulatePalette;
+begin
+  FPalette.Clear;
+  FPalette.AddBuiltinColors(true);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Writes an Excel BIFF8 file to the disc
 

components/fpspreadsheet/source/common/xlscommon.pas

@@ -534,6 +534,7 @@ type
     function GetLastColIndex(AWorksheet: TsWorksheet): Word;
     function GetPrintOptions: Word; virtual;
     function PaletteIndex(AColor: TsColor): Word;
+    procedure PopulatePalette; virtual;
 
     // Helper function for writing the BIFF header
     procedure WriteBIFFHeader(AStream: TStream; ARecID, ARecSize: Word);
@@ -3068,7 +3069,7 @@ begin
 
   // Color palette
   FPalette := TsPalette.Create;
-  FPalette.AddBuiltinColors;
+  PopulatePalette;
   FPalette.CollectFromWorkbook(AWorkbook);
 end;
 
@@ -3226,12 +3227,24 @@ function TsSpreadBIFFWriter.PaletteIndex(AColor: TsColor): Word;
 var
   idx: Integer;
 begin
-  idx := FPalette.FindColor(AColor, Limitations.MaxPaletteSize);
+  idx := FPalette.FindColor(AColor, Limitations.MaxPaletteSize, 8);
+  // Startindex 8 -- Skip built-in colors - they are not allowed to be edited
   if idx = -1 then
     idx := FPalette.FindClosestColorIndex(AColor, Limitations.MaxPaletteSize);
   Result := word(idx);
 end;
 
+procedure TsSpreadBIFFWriter.PopulatePalette;
+begin
+  with FPalette do
+  begin
+    Clear;
+    AddBuiltinColors(false); // 0..7
+    // Note: These colors cannot be edited by Excel. The format specific
+    // writer must duplicate these items (except for BIFF2).
+  end;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Writes the BIFF record header consisting of the record ID and the size of
   data to be written immediately afterwards.

components/fpspreadsheet/tests/colortests.pas

@@ -130,7 +130,9 @@ begin
       8: palette.UseColors(PALETTE_BIFF8);
     999: begin  // random palette: testing of color replacement
            palette.UseColors(PALETTE_BIFF8);
-           for i:=8 to 63 do   // first 8 colors must not be changed in Excel
+           // Loop begins at 16 because the first 8 colors must not be changed
+           // and the next 8 are duplicates for editingy in Excel
+           for i:=16 to 63 do
              palette[i] := random(256) + random(256) shr 8 + random(256) shr 16;
          end;
     else palette.AddBuiltinColors;
@@ -216,7 +218,9 @@ begin
       8: palette.UseColors(PALETTE_BIFF8);
     999: begin  // random palette: testing of color replacement
            palette.UseColors(PALETTE_BIFF8);
-           for i:=8 to 63 do   // first 8 colors must not be changed in Excel
+           // Loop begins at 16 because the first 8 colors must not be changed
+           // and the next 8 are duplicates for editingy in Excel
+           for i:=16 to 63 do
              palette[i] := random(256) + random(256) shr 8 + random(256) shr 16;
          end;
     else palette.AddBuiltinColors;

components/fpspreadsheet/tests/copytests.pas

@@ -65,7 +65,7 @@ const
 
 procedure MyInitCellRecord(out ACell: TCellRecord);
 begin
-  ACell.Contenttype := cctEmpty;
+  ACell.ContentType := cctEmpty;
   ACell.NumberValue := 0.0;
   ACell.UTF8StringValue := '';
   ACell.FormulaValue := '';
@@ -146,10 +146,11 @@ begin
 end;
 
 { This test prepares a worksheet and copies Values (ATestKind = 1 or 2), Formats
-  (AWhat = 3 or 4), or Formulas (AWhat = 5 or 6). The odd ATestKind number
+  (ATestKind = 3 or 4), or Formulas (ATestKind = 5 or 6).
-  copy the data to the empty column C, the even value copy them to the
+  The odd ATestKind numbers copy the data to the empty column C,
-  occupied column B which contains the source data (in column A) shifted down
+  the even ATestKind numbers copy them to the occupied column B which contains
-  by 1 cell. "The worksheet is saved, reloaded and compared to expectated data }
+  the source data (those from column A), but shifted down by 1 cell.
+  The worksheet is saved, reloaded and compared to expectated data }
 procedure TSpreadCopyTests.Test_Copy(ATestKind: Integer);
 const
   AFormat = sfExcel8;