pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Make sure that Excel's system colors are kept when colors are added to a palette. Fix BIFF 2 font color mismatch in unit test. All green again.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3471 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-11 22:39:47 +00:00
parent eaabdf67c1
commit 495499a9e2
5 changed files with 135 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

123
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1203,6 +1203,32 @@ resourcestring
lpErrArgError = '#N/A';
lpErrFormulaNotSupported = '<FORMULA?>';
const
{ These are reserved system colors by Microsoft
0x0040 Default foreground color - window text color in the sheet display.
0x0041 Default background color - window background color in the sheet display and is the default background color for a cell.
0x004D Default chart foreground color - window text color in the chart display.
0x004E Default chart background color - window background color in the chart display.
0x004F Chart neutral color which is black, an RGB value of (0,0,0).
0x0051 ToolTip text color - automatic font color for comments.
0x7FFF Font automatic color - window text color. }
DEF_FOREGROUND_COLOR = $0040;
DEF_BACKGROUND_COLOR = $0041;
DEF_CHART_FOREGROUND_COLOR = $004D;
DEF_CHART_BACKGROUND_COLOR = $004E;
DEF_CHART_NEUTRAL_COLOR = $004F;
DEF_TOOLTIP_TEXT_COLOR = $0051;
DEF_FONT_AUTOMATIC_COLOR = $7FFF;
DEF_FOREGROUND_COLORVALUE = $000000;
DEF_BACKGROUND_COLORVALUE = $FFFFFF;
DEF_CHART_FOREGROUND_COLORVALUE = $000000;
DEF_CHART_BACKGROUND_COLORVALUE = $FFFFFF;
DEF_CHART_NEUTRAL_COLORVALUE = $FFFFFF;
DEF_TOOLTIP_TEXT_COLORVALUE = $000000;
DEF_FONT_AUTOMATIC_COLORVALUE = $000000;
var
{@@ RGB colors RGB in "big-endian" notation (red at left). The values are inverted
at initialization to be little-endian at run-time!
@ -5452,17 +5478,74 @@ end;
@return Index of the new (or already existing) color item
}
function TsWorkbook.AddColorToPalette(AColorValue: TsColorValue): TsColor;
var
n: Integer;
begin
n := Length(FPalette);
// Look look for the color. Is it already in the existing palette?
if Length(FPalette) > 0 then
for Result := 0 to Length(FPalette)-1 do
if n > 0 then
for Result := 0 to n-1 do
if FPalette[Result] = AColorValue then
exit;
// No --> Add it to the palette.
Result := Length(FPalette);
SetLength(FPalette, Result+1);
FPalette[Result] := AColorValue;
// Do not overwrite Excel's built-in system colors
case n of
DEF_FOREGROUND_COLOR:
begin
SetLength(FPalette, n+3);
FPalette[n] := DEF_FOREGROUND_COLORVALUE;
FPalette[n+1] := DEF_BACKGROUND_COLORVALUE;
FPalette[n+2] := AColorValue;
end;
DEF_BACKGROUND_COLOR:
begin
SetLength(FPalette, n+2);
FPalette[n] := DEF_BACKGROUND_COLORVALUE;
FPalette[n+1] := AColorValue;
end;
DEF_CHART_FOREGROUND_COLOR:
begin
SetLength(FPalette, n+4);
FPalette[n] := DEF_CHART_FOREGROUND_COLORVALUE;
FPalette[n+1] := DEF_CHART_BACKGROUND_COLORVALUE;
FPalette[n+2] := DEF_CHART_NEUTRAL_COLORVALUE;
FPalette[n+3] := AColorValue;
end;
DEF_CHART_BACKGROUND_COLOR:
begin
SetLength(FPalette, n+3);
FPalette[n] := DEF_CHART_BACKGROUND_COLORVALUE;
FPalette[n+1] := DEF_CHART_NEUTRAL_COLORVALUE;
FPalette[n+2] := AColorValue;
end;
DEF_CHART_NEUTRAL_COLOR:
begin
SetLength(FPalette, n+2);
FPalette[n] := DEF_CHART_NEUTRAL_COLORVALUE;
FPalette[n+1] := AColorValue;
end;
DEF_TOOLTIP_TEXT_COLOR:
begin
SetLength(FPalette, n+2);
FPalette[n] := DEF_TOOLTIP_TEXT_COLORVALUE;
FPalette[n+1] := AColorValue;
end;
DEF_FONT_AUTOMATIC_COLOR:
begin
SetLength(FPalette, n+2);
FPalette[n] := DEF_FONT_AUTOMATIC_COLORVALUE;
FPalette[n+1] := AColorValue;
end;
else
begin
SetLength(FPalette, n+1);
FPalette[n] := AColorValue;
end;
end;
Result := Length(FPalette) - 1;
end;
{@@
@ -5600,13 +5683,36 @@ end;
}
function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): TsColorValue;
begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
Result := DEFAULT_PALETTE[AColorIndex]
else
Result := FPalette[AColorIndex];
end else
end
else
Result := $000000; // "black" as default
{
case AColorIndex of
$0040: Result := DEF_FOREGROUND_COLORVALUE;
$0041: Result := DEF_BACKGROUND_COLORVALUE;
$004D: Result := DEF_CHART_FOREGROUND_COLORVALUE;
$004E: Result := DEF_CHART_BACKGROUND_COLORVALUE;
$004F: Result := DEF_CHART_NEUTRAL_COLORVALUE;
$0051: Result := DEF_TOOLTIP_TEXT_COLORVALUE;
$7FFF: Result := DEF_FONT_AUTOMATIC_COLORVALUE;
else if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then
begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
Result := DEFAULT_PALETTE[AColorIndex]
else
Result := FPalette[AColorIndex];
end
else
Result := $000000; // "black" as default
end;
}
end;
{@@
@ -5677,6 +5783,9 @@ procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
var
i: Integer;
begin
if APaletteCount > 64 then
raise Exception.Create('Due to Excel-compatibility, palettes cannot have more then 64 colors.');
{$IFOPT R+}
{$DEFINE RNGCHECK}
{$ENDIF}

9
components/fpspreadsheet/tests/colortests.pas
View File

@ -266,9 +266,16 @@ begin
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
expectedRGB := pal[color];
colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
expectedRGB := pal[color]; //MyWorkbook.GetPaletteColor(color);
// Excel2 cannot write the entire palette. The writer had called "FixColor".
// We simulate that here to get the color correct.
if (AFormat = sfExcel2) and (color >= BIFF2_MAX_PALETTE_SIZE) then begin
color := MyWorkbook.FindClosestColor(expectedRGB, BIFF2_MAX_PALETTE_SIZE);
expectedRGB := MyWorkbook.GetPaletteColor(color);
end;
CheckEquals(expectedRGB, currentRGB,
'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
end;

5
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,12 +48,10 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -72,7 +70,6 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -99,6 +96,7 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -108,6 +106,7 @@
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>

10
components/fpspreadsheet/xlsbiff2.pas
View File

@ -36,6 +36,10 @@ uses
Classes, SysUtils,
fpspreadsheet, xlscommon, fpsutils, lconvencoding;
const
BIFF2_MAX_PALETTE_SIZE = 8;
// There are more colors but they do not seem to be controlled by a palette.
type
{ TsBIFF2NumFormatList }
@ -143,6 +147,8 @@ var
$00FFFF // $07: cyan
);
// However, it looks as if BIFF2 can handle more colors, at least 16 are
// compatible with the other formats.
implementation
@ -325,7 +331,7 @@ end;
constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FLimitations.MaxPaletteSize := 16;
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end;
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
@ -936,7 +942,7 @@ end;
constructor TsSpreadBIFF2Writer.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FLimitations.MaxPaletteSize := 16;
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end;
{ Creates the correct version of the number format list.

1
components/fpspreadsheet/xlscommon.pas
View File

@ -1815,7 +1815,6 @@ var
rgb: TsColorValue;
begin
if AColor >= Limitations.MaxPaletteSize then begin
// if AColor >= 64 then begin
rgb := Workbook.GetPaletteColor(AColor);
Result := Workbook.FindClosestColor(rgb, FLimitations.MaxPaletteSize);
end else