From e1f03daa5ccac1f6360c378fa9b1b5b2b960e87b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 17 May 2017 17:26:48 +0000 Subject: [PATCH] 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 --- .../source/common/fpspalette.pas | 24 +++++++++++++++---- .../fpspreadsheet/source/common/xlsbiff8.pas | 7 ++++++ .../fpspreadsheet/source/common/xlscommon.pas | 17 +++++++++++-- components/fpspreadsheet/tests/colortests.pas | 8 +++++-- components/fpspreadsheet/tests/copytests.pas | 11 +++++---- 5 files changed, 53 insertions(+), 14 deletions(-) diff --git a/components/fpspreadsheet/source/common/fpspalette.pas b/components/fpspreadsheet/source/common/fpspalette.pas index e3aa874db..58fd7bb48 100644 --- a/components/fpspreadsheet/source/common/fpspalette.pas +++ b/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; diff --git a/components/fpspreadsheet/source/common/xlsbiff8.pas b/components/fpspreadsheet/source/common/xlsbiff8.pas index 0d21794e2..4b16e7e69 100644 --- a/components/fpspreadsheet/source/common/xlsbiff8.pas +++ b/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 diff --git a/components/fpspreadsheet/source/common/xlscommon.pas b/components/fpspreadsheet/source/common/xlscommon.pas index 94f93825d..82b05a8e5 100644 --- a/components/fpspreadsheet/source/common/xlscommon.pas +++ b/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. diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas index 31a7253b7..289de89c8 100644 --- a/components/fpspreadsheet/tests/colortests.pas +++ b/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; diff --git a/components/fpspreadsheet/tests/copytests.pas b/components/fpspreadsheet/tests/copytests.pas index 93fc037d6..cd8cd813b 100644 --- a/components/fpspreadsheet/tests/copytests.pas +++ b/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 - copy the data to the empty column C, the even value copy them to the - occupied column B which contains the source data (in column A) shifted down - by 1 cell. "The worksheet is saved, reloaded and compared to expectated data } + (ATestKind = 3 or 4), or Formulas (ATestKind = 5 or 6). + The odd ATestKind numbers copy the data to the empty column C, + the even ATestKind numbers copy them to the occupied column B which contains + 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;