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

fpspreadsheet: Add unit test for writing/reading of background color in ods. Passed.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3108 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-27 16:21:59 +00:00
parent 11e09b888c
commit 4aa640489f
3 changed files with 62 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/fpsopendocument.pas
View File

@ -212,6 +212,8 @@ constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
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
FDateMode := dm1899;
end;
@ -858,7 +860,7 @@ begin
if styleChildNode.NodeName = 'style:table-cell-properties' then begin
// 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] := '$';
bkClr := StrToInt(s);
end;

35
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -556,6 +556,7 @@ type
function GetPaletteColor(AColorIndex: TsColor): TsColorValue;
procedure SetPaletteColor(AColorIndex: TsColor; AColorValue: TsColorValue);
function GetPaletteSize: Integer;
procedure UseDefaultPalette;
procedure UsePalette(APalette: PsPalette; APaletteCount: Word;
ABigEndian: Boolean = false);
{@@ 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
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;
var
i: Integer;
begin
// No palette yet? Add the 16 first entries of the default_palette. They are
// common to all palettes
if Length(FPalette) = 0 then begin
SetLength(FPalette, 16);
for i := 0 to 15 do
FPalette[i] := DEFAULT_PALETTE[i];
end;
// 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 FPalette[Result] = AColorValue then
exit;
// Now look for the color. Is already in the existing palette?
for Result := 0 to Length(FPalette)-1 do
if FPalette[Result] = AColorValue then
exit;
// No. Add it to the palette.
// No --> Add it to the palette.
Result := Length(FPalette);
SetLength(FPalette, Result+1);
FPalette[Result] := AColorValue;
@ -2883,7 +2879,7 @@ begin
g := TRgba(colorvalue).Green;
b := TRgba(colorvalue).Blue;
end;
Result := Format('%x%x%x', [r, g, b]);
Result := Format('%.2x%.2x%.2x', [r, g, b]);
end;
{@@
@ -2949,6 +2945,15 @@ begin
Result := Length(FPalette);
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
This palette is only used for writing. When reading the palette found in the

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

@ -54,6 +54,14 @@ type
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_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;
implementation
@ -110,17 +118,15 @@ begin
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);
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
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
row := 0;
col := 0;
@ -132,7 +138,7 @@ begin
fail('Error in test code. Failed to get cell.');
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
CheckEquals(expectedRGB, currentRGB,
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
@ -154,8 +160,8 @@ begin
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
expectedRGB := pal[color];
CheckEquals(expectedRGB, currentRGB,
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
MyWorkbook.Free;
@ -344,6 +350,28 @@ begin
TestWriteReadFontColors(sfExcel8, 999);
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
RegisterTest(TSpreadWriteReadColorTests);