You've already forked lazarus-ccr
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:
@ -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;
|
||||
|
@ -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
|
||||
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
Reference in New Issue
Block a user