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.