paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Fix Excel2003/XML format tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7050 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2019-07-18 15:58:16 +00:00
parent 290fd8f7ab
commit 3b0e46b92c
4 changed files with 91 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -6525,7 +6525,12 @@ end;
@param AStyle Fill style ("pattern") to be used - see TsFillStyle
@param APatternColor RGB value of the pattern color
@param ABackgroundColor RGB value of the background color
@return Index of the new format record.
@NOTE When AStyle is fsSolidFill the color is defined by APatternColor,
ABackgroundColor is ignored unless the APatternColor is not
used (scTransparent).
-------------------------------------------------------------------------------}
function TsWorksheet.ChangeBackground(AFormatIndex: Integer; AStyle: TsFillStyle;
APatternColor: TsColor = scTransparent;
@ -6543,10 +6548,16 @@ begin
Include(fmt.UsedFormattingFields, uffBackground);
fmt.Background.Style := AStyle;
fmt.Background.FgColor := APatternColor;
if (AStyle = fsSolidFill) and (APatternColor = scTransparent) then
fmt.Background.FgColor := ABackgroundColor
else
fmt.Background.BgColor := ABackgroundColor;
{
if (AStyle = fsSolidFill) and (ABackgroundColor = scTransparent) then
fmt.Background.BgColor := APatternColor
else
fmt.Background.BgColor := ABackgroundColor;
}
end;
Result := Workbook.AddCellFormat(fmt);
end;
@ -6561,7 +6572,11 @@ end;
@param ABackgroundColor RGB value of the background color
@return Pointer to cell
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
@NOTE When AStyle is fsSolidFill the color is defined by APatternColor,
ABackgroundColor is ignored unless the APatternColor is not
used (scTransparent).
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle;
APatternColor, ABackgroundColor: TsColor): PCell;
@ -6578,7 +6593,11 @@ end;
@param APatternColor RGB value of the pattern color
@param ABackgroundColor RGB value of the background color
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
@NOTE When AStyle is fsSolidFill the color is defined by APatternColor,
ABackgroundColor is ignored unless the APatternColor is not
used (scTransparent).
@NOTE Is replaced by uniform fill if WriteBackgroundColor is called later.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteBackground(ACell: PCell; AStyle: TsFillStyle;
APatternColor: TsColor = scTransparent; ABackgroundColor: TsColor = scTransparent);

2
components/fpspreadsheet/source/common/fpstypes.pas
View File

@ -553,7 +553,7 @@ type
TsFillPattern = record
Style: TsFillStyle; // pattern type
FgColor: TsColor; // pattern color
BgColor: TsColor; // background color
BgColor: TsColor; // background color (undefined when Style=fsSolidFill)
end;
const

71
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -158,7 +158,8 @@ const
fsHatchDiag, fsThinHatchDiag, fsThickHatchDiag, fsThinHatchHor) }
FILL_NAMES: array[TsFillStyle] of string = (
'', 'Solid',
'Gray75', 'Gray50', 'Gray25', 'Gray12', 'Gray0625',
// 'Solid', 'Solid', 'Solid', 'Solid', 'Solid',
'Gray75', 'Gray50', 'Gray25', 'Gray125', 'Gray0625',
'HorzStripe', 'VertStripe', 'DiagStripe', 'ReverseDiagStripe',
'ThinHorzStripe', 'ThinVertStripe', 'ThinDiagStripe', 'ThinReverseDiagStripe',
'DiagCross', 'ThinDiagCross', 'ThickDiagCross', 'ThinHorzCross'
@ -378,7 +379,10 @@ begin
// Border color
s := GetAttrValue(ANode, 'ss:Color');
AFormat.BorderStyles[b].Color := HTMLColorStrToColor(s);
if s = '' then
AFormat.BorderStyles[b].Color := scBlack
else
AFormat.BorderStyles[b].Color := HTMLColorStrToColor(s);
// Line style
s := GetAttrValue(ANode, 'ss:LineStyle');
@ -690,12 +694,13 @@ end;
procedure TsSpreadExcelXMLReader.ReadInterior(ANode: TDOMNode;
var AFormat: TsCellFormat);
var
s: String;
s, sfg, sbg: String;
fs: TsFillStyle;
begin
if ANode = nil then
exit;
// Pattern
s := GetAttrValue(ANode, 'ss:Pattern');
if s = '' then
exit;
@ -706,18 +711,25 @@ begin
break;
end;
s := GetAttrValue(ANode, 'ss:PatternColor');
if s = '' then
// Foreground color (pattern color)
sfg := GetAttrValue(ANode, 'ss:PatternColor');
if sfg = '' then
AFormat.Background.FgColor := scBlack
else
AFormat.Background.FgColor := HTMLColorStrToColor(s);
AFormat.Background.FgColor := HTMLColorStrToColor(sfg);
s := GetAttrValue(ANode, 'ss:Color');
if s = '' then
// Background color
sbg := GetAttrValue(ANode, 'ss:Color');
if sbg = '' then
AFormat.Background.BgColor := scWhite
else begin
AFormat.Background.BgColor := HTMLColorStrToColor(s);
if AFormat.Background.Style = fsSolidFill then
else
AFormat.Background.BgColor := HTMLColorStrToColor(sbg);
// Fix solid fill colors: make foreground and background color the same
if AFormat.Background.Style = fsSolidFill then begin
if (sfg <> '') then
AFormat.Background.BgColor := AFormat.Background.FgColor // Forground priority
else if (sfg = '') and (sbg <> '') then
AFormat.Background.FgColor := AFormat.Background.BgColor;
end;
@ -972,6 +984,7 @@ var
x: Double;
idx: Integer;
fmt: TsCellFormat;
rht: TsRowHeightType;
begin
r := 0;
c := 0;
@ -1022,10 +1035,17 @@ begin
s := GetAttrValue(ANode, 'ss:Index');
if s <> '' then r := StrToInt(s) - 1;
// AutoFitHeight
s := GetAttrValue(ANode, 'ss:AutoFitHeight');
if s = '1' then
rht := rhtAuto
else
rht := rhtCustom;
// Height
s := GetAttrValue(ANode, 'ss:Height');
if (s <> '') and TryStrToFloat(s, x, FPointSeparatorSettings) then
sheet.WriteRowHeight(r, x, suPoints);
sheet.WriteRowHeight(r, x, suPoints, rht);
// Hidden
s := GetAttrValue(ANode, 'ss:Hidden');
@ -1985,13 +2005,13 @@ begin
end;
// Vertical alignment
fmtVert := 'ss:Vertical="Bottom" ';
fmtVert := '';
if uffVertAlign in fmt^.UsedFormattingFields then
case fmt^.VertAlignment of
vaDefault: ;
vaTop : fmtVert := 'ss:Vertical="Top" ';
vaCenter : fmtVert := 'ss:Vertical="Center" ';
vaBottom : ;
vaBottom : fmtVert := 'ss:Vertical="Bottom" ';
else
raise EFPSpreadsheetWriter.Create('[TsSpreadXMLWriter.WriteStyle] Vertical alignment cannot be handled.');
end;
@ -2053,12 +2073,20 @@ begin
if (uffBackground in fmt^.UsedFormattingFields) then
begin
fill := fmt^.Background;
s := 'ss:Color="' + ColorToHTMLColorStr(fill.BgColor) + '" ';
if not (fill.Style in [fsNoFill, fsSolidFill]) then
s := s + 'ss:PatternColor="' + ColorToHTMLColorStr(fill.FgColor) + '" ';
s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '"';
AppendToStream(AStream, INDENT3 +
'<Interior ' + s + '/>' + LF)
if fill.Style = fsNoFill then
AppendToStream(AStream, INDENT3 + '<Interior />' + LF)
else begin
if fill.Style = fsSolidFill then
s := 'ss:Color="' + ColorToHtmlColorStr(fill.FgColor) + '" '
else
s := Format('ss:Color="%s" ss:PatternColor="%s" ', [
ColorToHTMLColorStr(fill.BgColor),
ColorToHTMLColorStr(fill.FgColor)
]);
s := s + 'ss:Pattern="' + FILL_NAMES[fill.Style] + '" ';
AppendToStream(AStream, INDENT3 +
'<Interior ' + s + '/>' + LF)
end;
end;
// Borders
@ -2072,8 +2100,7 @@ begin
BORDER_NAMES[cb], LINE_STYLES[cbs.LineStyle]]);
if fmt^.BorderStyles[cb].LineStyle <> lsHair then
s := Format('%s ss:Weight="%d"', [s, LINE_WIDTHS[cbs.LineStyle]]);
if fmt^.BorderStyles[cb].Color <> scBlack then
s := Format('%s ss:Color="%s"', [s, ColorToHTMLColorStr(cbs.Color)]);
s := Format('%s ss:Color="%s"', [s, ColorToHTMLColorStr(cbs.Color)]);
s := s + '/>' + LF;
end;
if s <> '' then

41
components/fpspreadsheet/tests/formattests.pas
View File

@ -815,7 +815,8 @@ begin
GetColorName(PATTERN_COLOR),
GetColorName(patt.FgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
if BK_COLOR <> patt.BgColor then
if (BK_COLOR <> patt.BgColor) and (style <> fsSolidFill) then
// Backgroundcolor is undefined for solid fill
CheckEquals(
GetColorName(BK_COLOR),
GetColorName(patt.BgColor),
@ -832,21 +833,17 @@ begin
GetEnumName(TypeInfo(TsFillStyle), ord(style)),
GetEnumName(TypeInfo(TsFillStyle), ord(patt.Style)),
'Test saved fill style mismatch, cell ' + CellNotation(MyWorksheet, row, col));
if style <> fsNoFill then
// Skip ExcelXML because it does not store info on transparent background fill.
if (style <> fsNoFill) and (AFormat <> sfExcelXML) then
begin
if PATTERN_COLOR <> patt.FgColor then
CheckEquals(
GetColorName(PATTERN_COLOR),
GetColorName(patt.FgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col));
// SolidFill is a special case: here the background color is always equal
// to the pattern color - the cell layout does not know this...
if style = fsSolidFill then
CheckEquals(
GetColorName(PATTERN_COLOR),
GetColorName(patt.BgColor),
'Test saved fill pattern color mismatch, cell ' + CellNotation(MyWorksheet, row, col))
else
// SolidFill is a special case: here the background color is not defined.
if style <> fsSolidFill then
CheckEquals(
GetColorName(scTransparent),
GetColorName(patt.BgColor),
@ -1004,7 +1001,7 @@ procedure TSpreadWriteReadFormatTests.TestWriteRead_BorderStyles(AFormat: TsSpre
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
MyCell: PCell;
cell: PCell;
row, col: Integer;
b: TsCellBorder;
expected: Integer;
@ -1026,7 +1023,7 @@ begin
MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet);
borders := [cbNorth, cbSouth, cbEast, cbWest];
if AFormat in [sfExcel8, sfOpenDocument, sfOOXML] then
if AFormat in [sfExcel8, sfExcelXML, sfOOXML, sfOpenDocument] then
borders := borders + [cbDiagUp, cbDiagDown];
c := 0;
@ -1035,11 +1032,12 @@ begin
begin
for col := 1 to 10 do
begin
MyWorksheet.WriteBorders(row*2-1, col*2-1, borders);
cell := MyWorksheet.GetCell(row*2-1, col*2-1);
MyWorksheet.WriteBorders(cell, borders);
for b in borders do
begin
MyWorksheet.WriteBorderLineStyle(row*2-1, col*2-1, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(row*2-1, col*2-1, b, SollBorderColors[c]);
MyWorksheet.WriteBorderLineStyle(cell, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(cell, b, SollBorderColors[c]);
inc(ls);
if ls > High(SollBorderLineStyles) then
begin
@ -1073,12 +1071,12 @@ begin
begin
for col := 1 to 10 do
begin
MyCell := MyWorksheet.FindCell(row*2-1, col*2-1);
if myCell = nil then
cell := MyWorksheet.FindCell(row*2-1, col*2-1);
if cell = nil then
fail('Error in test code. Failed to get cell.');
for b in borders do
begin
borderStyle := MyWorksheet.ReadCellBorderStyle(MyCell, b);
borderStyle := MyWorksheet.ReadCellBorderStyle(cell, b);
current := ord(borderStyle.LineStyle);
// In Excel both diagonals have the same line style. The reader picks
// the line style of the "diagonal-up" border. We use this as expected
@ -1090,7 +1088,7 @@ begin
cbDiagDown : expected := diagUp_ls;
end;
CheckEquals(expected, current,
'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2-1, col*2-1));
current := borderStyle.Color;
expected := SollBorderColors[c];
// In Excel both diagonals have the same line color. The reader picks
@ -1102,7 +1100,7 @@ begin
cbDiagDown : expected := diagUp_clr;
end;
CheckEquals(expected, current,
'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2-1, col*2-1));
inc(ls);
if ls > High(SollBorderLineStyles) then begin
ls := 0;
@ -1257,7 +1255,8 @@ begin
MyWorkSheet:= MyWorkBook.AddWorksheet(RowHeightSheet);
for Row := Low(SollRowHeights) to High(SollRowHeights) do begin
if SollRowHeights[Row] < 0 then
rht := rhtAuto else
rht := rhtAuto
else
rht := rhtCustom;
MyWorksheet.WriteRowHeight(Row, abs(SollRowHeights[Row]), suLines, rht);
end;