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

fpspreadsheet: Fix OOXML writer using incorrect color if palette index is >63. Activate color count error test for ooxml and ods.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3472 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-12 09:05:19 +00:00
parent 495499a9e2
commit f35eae9379
3 changed files with 33 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1178,8 +1178,8 @@ resourcestring
'file format does not support more than %d rows.';
lpMaxColsExceeded = 'This workbook contains %d columns, but the selected ' +
'file format does not support more than %d columns.';
lpTooManyPaletteColors = 'This workbook contains more colors (%d) than are ' +
'supported by the file format (%d). The redundant colors are replaced by '+
lpTooManyPaletteColors = 'This workbook contains more colors (%d) than ' +
'supported by the file format (%d). The additional colors are replaced by '+
'the best-matching palette colors.';
lpInvalidFontIndex = 'Invalid font index';
lpInvalidNumberFormat = 'Trying to use an incompatible number format.';

43
components/fpspreadsheet/tests/errortests.pas
View File

@ -66,6 +66,7 @@ var
TempFile: String;
ErrList: TStringList;
newColor: TsColor;
expected: integer;
begin
formula.FormulaStr := '=A1';
formula.DoubleValue := 0.0;
@ -119,27 +120,31 @@ begin
end;
// Test 3: Too many colors
if (TTestFormat(AFormat) in [sfExcel2, sfExcel5, sfExcel8]) then begin
MyWorkbook := TsWorkbook.Create;
try
// Prepare a full palette
MyWorkbook.UsePalette(@PALETTE_BIFF5[0], Length(PALETTE_BIFF5));
// Add 1 more color - this is one too many for BIFF5 and 8, and a lot
// too many for BIFF2 !
newColor := MyWorkbook.AddColorToPalette($FF7878);
MyWorkbook := TsWorkbook.Create;
try
// Prepare a full palette
MyWorkbook.UsePalette(@PALETTE_BIFF5[0], Length(PALETTE_BIFF5));
// Add 1 more color - this is one too many for BIFF5 and 8, and a lot
// too many for BIFF2 !
newColor := MyWorkbook.AddColorToPalette($FF7878);
MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET);
MyWorksheet.WriteUTF8Text(0, 0, s);
MyWorksheet.WriteFontColor(0, 0, newColor);
MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET);
MyWorksheet.WriteUTF8Text(0, 0, s);
MyWorksheet.WriteFontColor(0, 0, newColor);
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
ErrList.Text := MyWorkbook.ErrorMsg;
CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
ErrList.Text := MyWorkbook.ErrorMsg;
// Palette usage in biff --> expecting error due to too large palette
if (TTestFormat(AFormat) in [sfExcel2, sfExcel5, sfExcel8]) then
expected := 1
else
// no palette in xml --> no error expected
expected := 0;
CheckEquals(expected, ErrList.Count, 'Error count mismatch in test 3');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
// Test 4: Too long cell label

10
components/fpspreadsheet/xlsxooxml.pas
View File

@ -1754,6 +1754,7 @@ var
i: Integer;
font: TsFont;
s: String;
rgb: TsColorValue;
begin
AppendToStream(FSStyles, Format(
'<fonts count="%d">', [Workbook.GetFontCount]));
@ -1774,9 +1775,12 @@ begin
if (fssStrikeout in font.Style) then
s := s + '<strike />';
if font.Color <> scBlack then begin
s := s + Format('<color indexed="%d" />', [font.Color]);
// rgb := Workbook.GetPaletteColor(font.Color);
// s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
if font.Color < 64 then
s := s + Format('<color indexed="%d" />', [font.Color])
else begin
rgb := Workbook.GetPaletteColor(font.Color);
s := s + Format('<color rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]);
end;
end;
AppendToStream(AStream,
'<font>', s, '</font>');