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
This commit is contained in:
wp_xxyyzz
2017-05-17 17:26:48 +00:00
parent 61a08b692e
commit e1f03daa5c
5 changed files with 53 additions and 14 deletions

View File

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

View File

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

View File

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

View File

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

View File

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