You've already forked lazarus-ccr
fpspreadsheet: Add unit test for writing/reading of background color in ods. Passed.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3108 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -212,6 +212,8 @@ constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
|
|||||||
begin
|
begin
|
||||||
inherited Create(AWorkbook);
|
inherited Create(AWorkbook);
|
||||||
FStyleList := TFPList.Create;
|
FStyleList := TFPList.Create;
|
||||||
|
// Set up the default palette in order to have the default color names correct.
|
||||||
|
Workbook.UseDefaultPalette;
|
||||||
// Initial base date in case it won't be read from file
|
// Initial base date in case it won't be read from file
|
||||||
FDateMode := dm1899;
|
FDateMode := dm1899;
|
||||||
end;
|
end;
|
||||||
@ -858,7 +860,7 @@ begin
|
|||||||
if styleChildNode.NodeName = 'style:table-cell-properties' then begin
|
if styleChildNode.NodeName = 'style:table-cell-properties' then begin
|
||||||
// Background color
|
// Background color
|
||||||
s := GetAttrValue(styleChildNode, 'fo:background-color');
|
s := GetAttrValue(styleChildNode, 'fo:background-color');
|
||||||
if s <> '' then begin
|
if (s <> '') and (s <> 'transparent') then begin
|
||||||
if s[1] = '#' then s[1] := '$';
|
if s[1] = '#' then s[1] := '$';
|
||||||
bkClr := StrToInt(s);
|
bkClr := StrToInt(s);
|
||||||
end;
|
end;
|
||||||
|
@ -556,6 +556,7 @@ type
|
|||||||
function GetPaletteColor(AColorIndex: TsColor): TsColorValue;
|
function GetPaletteColor(AColorIndex: TsColor): TsColorValue;
|
||||||
procedure SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
|
procedure SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
|
||||||
function GetPaletteSize: Integer;
|
function GetPaletteSize: Integer;
|
||||||
|
procedure UseDefaultPalette;
|
||||||
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
|
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
|
||||||
ABigEndian: Boolean = false);
|
ABigEndian: Boolean = false);
|
||||||
{@@ This property is only used for formats which don't support unicode
|
{@@ This property is only used for formats which don't support unicode
|
||||||
@ -2835,25 +2836,20 @@ end;
|
|||||||
{@@
|
{@@
|
||||||
Adds a color to the palette and returns its palette index, but only if the
|
Adds a color to the palette and returns its palette index, but only if the
|
||||||
color does not already exist - in this case, it returns the index of the
|
color does not already exist - in this case, it returns the index of the
|
||||||
existing color entry. }
|
existing color entry.
|
||||||
|
The color must in little-endian notation (like TColor of the graphics units)
|
||||||
|
}
|
||||||
function TsWorkbook.AddColorToPalette(AColorValue: TsColorValue): TsColor;
|
function TsWorkbook.AddColorToPalette(AColorValue: TsColorValue): TsColor;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
// No palette yet? Add the 16 first entries of the default_palette. They are
|
// Look look for the color. Is it already in the existing palette?
|
||||||
// common to all palettes
|
if Length(FPalette) > 0 then
|
||||||
if Length(FPalette) = 0 then begin
|
for Result := 0 to Length(FPalette)-1 do
|
||||||
SetLength(FPalette, 16);
|
if FPalette[Result] = AColorValue then
|
||||||
for i := 0 to 15 do
|
exit;
|
||||||
FPalette[i] := DEFAULT_PALETTE[i];
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Now look for the color. Is already in the existing palette?
|
// No --> Add it to the palette.
|
||||||
for Result := 0 to Length(FPalette)-1 do
|
|
||||||
if FPalette[Result] = AColorValue then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
// No. Add it to the palette.
|
|
||||||
Result := Length(FPalette);
|
Result := Length(FPalette);
|
||||||
SetLength(FPalette, Result+1);
|
SetLength(FPalette, Result+1);
|
||||||
FPalette[Result] := AColorValue;
|
FPalette[Result] := AColorValue;
|
||||||
@ -2883,7 +2879,7 @@ begin
|
|||||||
g := TRgba(colorvalue).Green;
|
g := TRgba(colorvalue).Green;
|
||||||
b := TRgba(colorvalue).Blue;
|
b := TRgba(colorvalue).Blue;
|
||||||
end;
|
end;
|
||||||
Result := Format('%x%x%x', [r, g, b]);
|
Result := Format('%.2x%.2x%.2x', [r, g, b]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{@@
|
{@@
|
||||||
@ -2949,6 +2945,15 @@ begin
|
|||||||
Result := Length(FPalette);
|
Result := Length(FPalette);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{@@
|
||||||
|
Instructs the workbook to take colors from the default palette. Is called
|
||||||
|
from ODS reader because ODS does not have a palette. Without a palette the
|
||||||
|
color constants (scRed etc.) would not be correct any more. }
|
||||||
|
procedure TsWorkbook.UseDefaultPalette;
|
||||||
|
begin
|
||||||
|
UsePalette(@DEFAULT_PALETTE, Length(DEFAULT_PALETTE), false);
|
||||||
|
end;
|
||||||
|
|
||||||
{@@
|
{@@
|
||||||
Instructs the Workbook to take colors from the palette pointed to by the parameter
|
Instructs the Workbook to take colors from the palette pointed to by the parameter
|
||||||
This palette is only used for writing. When reading the palette found in the
|
This palette is only used for writing. When reading the palette found in the
|
||||||
|
@ -54,6 +54,14 @@ type
|
|||||||
procedure TestWriteReadBIFF8_Font_Biff5Pal; // official biff5 palette in BIFF8 file format
|
procedure TestWriteReadBIFF8_Font_Biff5Pal; // official biff5 palette in BIFF8 file format
|
||||||
procedure TestWriteReadBIFF8_Font_Biff8Pal; // official biff8 palette in BIFF8 file format
|
procedure TestWriteReadBIFF8_Font_Biff8Pal; // official biff8 palette in BIFF8 file format
|
||||||
procedure TestWriteReadBIFF8_Font_RandomPal; // palette 64, top 56 entries random
|
procedure TestWriteReadBIFF8_Font_RandomPal; // palette 64, top 56 entries random
|
||||||
|
|
||||||
|
{ OpenDocument file format tests }
|
||||||
|
// Background colors...
|
||||||
|
procedure TestWriteReadODS_Background_InternalPal; // internal palette
|
||||||
|
procedure TestWriteReadODS_Background_Biff5Pal; // official biff5 palette
|
||||||
|
procedure TestWriteReadODS_Background_Biff8Pal; // official biff8 palette
|
||||||
|
procedure TestWriteReadODS_Background_RandomPal; // palette 64, top 56 entries random
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -110,17 +118,15 @@ begin
|
|||||||
for i:=8 to 63 do // first 8 colors cannot be changed
|
for i:=8 to 63 do // first 8 colors cannot be changed
|
||||||
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
|
MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16);
|
||||||
end;
|
end;
|
||||||
{
|
|
||||||
999: begin // Random palette
|
|
||||||
SetLength(pal, 64);
|
|
||||||
for i:=0 to 67 do pal[i] := PALETTE_BIFF8[i];
|
|
||||||
for i:=8 to 63 do pal[i] := Random(256) + Random(256) shr 8 + random(256) shr 16;
|
|
||||||
MyWorkbook.UsePalette(@pal[0], 64);
|
|
||||||
end; }
|
|
||||||
|
|
||||||
// else use default palette
|
// else use default palette
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// Remember all colors because ODS does not have a palette in the file; therefore
|
||||||
|
// we do not know which colors to expect.
|
||||||
|
SetLength(pal, MyWorkbook.GetPaletteSize);
|
||||||
|
for i:=0 to High(pal) do
|
||||||
|
pal[i] := MyWorkbook.GetPaletteColor(i);
|
||||||
|
|
||||||
// Write out all colors
|
// Write out all colors
|
||||||
row := 0;
|
row := 0;
|
||||||
col := 0;
|
col := 0;
|
||||||
@ -132,7 +138,7 @@ begin
|
|||||||
fail('Error in test code. Failed to get cell.');
|
fail('Error in test code. Failed to get cell.');
|
||||||
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
|
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
|
||||||
expectedRGB := MyWorkbook.GetPaletteColor(color);
|
expectedRGB := MyWorkbook.GetPaletteColor(color);
|
||||||
CheckEquals(currentRGB, expectedRGB,
|
CheckEquals(expectedRGB, currentRGB,
|
||||||
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
|
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
|
||||||
inc(row);
|
inc(row);
|
||||||
end;
|
end;
|
||||||
@ -154,8 +160,8 @@ begin
|
|||||||
fail('Error in test code. Failed to get cell.');
|
fail('Error in test code. Failed to get cell.');
|
||||||
color := TsColor(row);
|
color := TsColor(row);
|
||||||
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
|
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
|
||||||
expectedRGB := MyWorkbook.GetPaletteColor(color);
|
expectedRGB := pal[color];
|
||||||
CheckEquals(currentRGB, expectedRGB,
|
CheckEquals(expectedRGB, currentRGB,
|
||||||
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
|
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
|
||||||
end;
|
end;
|
||||||
MyWorkbook.Free;
|
MyWorkbook.Free;
|
||||||
@ -344,6 +350,28 @@ begin
|
|||||||
TestWriteReadFontColors(sfExcel8, 999);
|
TestWriteReadFontColors(sfExcel8, 999);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ Tests for Open Document file format }
|
||||||
|
procedure TSpreadWriteReadColorTests.TestWriteReadODS_Background_InternalPal;
|
||||||
|
begin
|
||||||
|
TestWriteReadBackgroundColors(sfOpenDocument, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSpreadWriteReadColorTests.TestWriteReadODS_Background_Biff5Pal;
|
||||||
|
begin
|
||||||
|
TestWriteReadBackgroundColors(sfOpenDocument, 5);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSpreadWriteReadColorTests.TestWriteReadODS_Background_Biff8Pal;
|
||||||
|
begin
|
||||||
|
TestWriteReadBackgroundColors(sfOpenDocument, 8);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSpreadWriteReadColorTests.TestWriteReadODS_Background_RandomPal;
|
||||||
|
begin
|
||||||
|
TestWriteReadBackgroundColors(sfOpenDocument, 999);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTest(TSpreadWriteReadColorTests);
|
RegisterTest(TSpreadWriteReadColorTests);
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user