diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas
index 74e96fc7c..bb9b7310b 100644
--- a/components/fpspreadsheet/source/common/fpspreadsheet.pas
+++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas
@@ -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);
diff --git a/components/fpspreadsheet/source/common/fpstypes.pas b/components/fpspreadsheet/source/common/fpstypes.pas
index b8a96e6db..25a7029d0 100644
--- a/components/fpspreadsheet/source/common/fpstypes.pas
+++ b/components/fpspreadsheet/source/common/fpstypes.pas
@@ -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
diff --git a/components/fpspreadsheet/source/common/xlsxml.pas b/components/fpspreadsheet/source/common/xlsxml.pas
index 39ecc9579..f94444a6f 100644
--- a/components/fpspreadsheet/source/common/xlsxml.pas
+++ b/components/fpspreadsheet/source/common/xlsxml.pas
@@ -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 +
- '' + LF)
+ if fill.Style = fsNoFill then
+ AppendToStream(AStream, INDENT3 + '' + 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 +
+ '' + 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
diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas
index c7a3d0188..7853f25d9 100644
--- a/components/fpspreadsheet/tests/formattests.pas
+++ b/components/fpspreadsheet/tests/formattests.pas
@@ -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;