diff --git a/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas b/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
index fcd156c24..98da5107e 100644
--- a/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
+++ b/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
@@ -195,8 +195,9 @@ begin
// conditional format #6: unique
inc(row);
sh.WriteText(row, 0, 'unique values');
- sh.WriteText(row, 1, 'background bright red');
- fmt.SetBackgroundColor($D0D0FF);
+ sh.WriteText(row, 1, 'borders all sides');
+ InitFormatRecord(fmt);
+ fmt.SetBorders(ALL_BORDERS);
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcUnique, fmtIdx);
@@ -204,6 +205,7 @@ begin
inc(row);
sh.WriteText(row, 0, 'contains any text');
sh.WriteText(row, 1, 'background red');
+ InitFormatRecord(fmt);
fmt.SetBackgroundColor(scRed);
fmtIdx := wb.AddCellFormat(fmt);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcContainsText, '', fmtIdx);
diff --git a/components/fpspreadsheet/source/common/fpstypes.pas b/components/fpspreadsheet/source/common/fpstypes.pas
index 547c05232..5e32f1ce9 100644
--- a/components/fpspreadsheet/source/common/fpstypes.pas
+++ b/components/fpspreadsheet/source/common/fpstypes.pas
@@ -541,6 +541,7 @@ const
);
{@@ Border style to be used for "no border"}
+
NO_CELL_BORDER: TsCellBorderStyle = (LineStyle: lsThin; Color: scNotDefined);
ALL_BORDERS: TsCellBorders = [cbNorth, cbEast, cbSouth, cbWest];
@@ -729,6 +730,7 @@ type
const AColor: TsColor = scBlack; const ALineStyle: TsLineStyle = lsThin);
procedure SetFont(AFontIndex: Integer);
procedure SetHorAlignment(AHorAlign: TsHorAlignment);
+ procedure SetNumberFormat(AIndex: Integer);
procedure SetTextRotation(ARotation: TsTextRotation);
procedure SetVertAlignment(AVertAlign: TsVertAlignment);
end;
@@ -1123,6 +1125,12 @@ begin
UsedFormattingFields := usedFormattingFields + [uffHorAlign];
end;
+procedure TsCellFormat.SetNumberFormat(AIndex: Integer);
+begin
+ NumberFormatIndex := AIndex;
+ UsedFormattingFields := UsedFormattingFields + [uffNumberFormat];
+end;
+
procedure TsCellFormat.SetTextRotation(ARotation: TsTextRotation);
begin
TextRotation := ARotation;
diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas
index 2300435fa..f17b4df0c 100644
--- a/components/fpspreadsheet/source/common/fpsutils.pas
+++ b/components/fpspreadsheet/source/common/fpsutils.pas
@@ -652,6 +652,9 @@ function ParseCellString(const AStr: String; out ACellRow, ACellCol: Cardinal;
end;
end;
+ if (ACellCol = 0) or (ACellRow = 0) then
+ exit;
+
dec(ACellCol);
dec(ACellRow);
if not isAbs then Include(AFlags, rfRelRow);
diff --git a/components/fpspreadsheet/source/common/xlsxml.pas b/components/fpspreadsheet/source/common/xlsxml.pas
index 8ddda5efc..c0b8c47f3 100644
--- a/components/fpspreadsheet/source/common/xlsxml.pas
+++ b/components/fpspreadsheet/source/common/xlsxml.pas
@@ -44,6 +44,7 @@ type
procedure ReadCell(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ARow, ACol: Integer);
procedure ReadCellProtection(ANode: TDOMNode; var AFormat: TsCellFormat);
procedure ReadComment(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; ACell: PCell);
+ procedure ReadConditionalFormatting(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
procedure ReadExcelWorkbook(ANode: TDOMNode);
procedure ReadFont(ANode: TDOMNode; var AFormat: TsCellFormat);
procedure ReadInterior(ANode: TDOMNode; var AFormat: TsCellFormat);
@@ -81,7 +82,7 @@ type
function GetFormulaStr(ACell: PCell): String;
function GetFrozenPanesStr(AWorksheet: TsBasicWorksheet; AIndent: String): String;
function GetHyperlinkStr(ACell: PCell): String;
- function GetIndexStr(AIndex, APrevIndex: Integer): String;
+ function GetIndexStr(AIndex, APrevIndex: Cardinal): String;
function GetLayoutStr(AWorksheet: TsBasicWorksheet): String;
function GetMergeStr(ACell: PCell): String;
function GetPageFooterStr(AWorksheet: TsBasicWorksheet): String;
@@ -182,6 +183,15 @@ const
'DiagCross', 'ThinDiagCross', 'ThickDiagCross', 'ThinHorzCross'
);
+ { Fill style names as used in the Style attribute for conditional formatting -- not all tested... }
+ CF_FILL_NAMES: array[TsFillStyle] of string = (
+ '', 'solid',
+ 'gray-75', 'gray-50', 'gray-25', 'gray-125', 'gray-0625',
+ 'horz-stripe', 'vert-stripe', 'diag-stripe', 'reverse-diag-stripe',
+ 'thin-horz-stripe', 'thin-vert-stripe', 'thin-diag-stripe', 'thin-reverse-diag-stripe',
+ 'diag-cross', 'thin-diag-cross', 'thick-diag-cross', 'thin-horz-cross'
+ );
+
{TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown); }
BORDER_NAMES: array[TsCellBorder] of string = (
'Top', 'Left', 'Right', 'Bottom', 'DiagonalRight', 'DiagonalLeft'
@@ -197,7 +207,7 @@ const
'SlantDashDot'
);
- LINE_STYLES1: array[TsLineStyle] of string = (
+ CF_LINE_STYLES: array[TsLineStyle] of string = (
'solid', 'solid', 'dashed', 'dotted', 'solid', 'double', 'hairline',
'dashed', 'dot-dash', 'dot-dash', 'dot-dot-dash', 'dot-dot-dash',
'dot-dash'
@@ -313,6 +323,42 @@ begin
end;
end;
+function TryStrToCFLineStyle(s: String; out ALineStyle: TsLineStyle): Boolean;
+var
+ ls: TsLineStyle;
+begin
+ for ls in TsLineStyle do
+ if s = CF_LINE_STYLES[ls] then
+ begin
+ Result := true;
+ ALineStyle := ls;
+ exit;
+ end;
+ Result := false;
+end;
+
+function TryStrToCFCellBorder(s: String; out ABorder: TsCellBorder): Boolean;
+var
+ cb: TsCellBorder;
+begin
+ Result := true;
+ if s = 'border-left' then
+ ABorder := cbWest
+ else if s = 'border-right' then
+ Aborder := cbEast
+ else if s = 'border-top' then
+ ABorder := cbNorth
+ else if s = 'border-bottom' then
+ ABorder := cbSouth
+ else if s = 'border-diagonal-right' then // not tested !
+ ABorder := cbDiagUp
+ else if s = 'border-diagonal-left' then // not tested !
+ ABorder := cbDiagDown
+ else
+ Result := false;
+end;
+
+
{===============================================================================
TsSpreadExcelXMLReader
===============================================================================}
@@ -703,6 +749,247 @@ begin
TsWorksheet(AWorksheet).WriteComment(ACell, txt);
end;
+{@@ ----------------------------------------------------------------------------
+ Reads the "Worksheet/ConditionalFormatting" node
+-------------------------------------------------------------------------------}
+procedure TsSpreadExcelXMLReader.ReadConditionalFormatting(ANode: TDOMNode;
+ AWorksheet: TsBasicWorksheet);
+var
+ book: TsWorkbook;
+ sheet: TsWorksheet;
+ childNode: TDOMNode;
+ nodeName: String;
+ s, nameStr, valueStr, tmpStr: String;
+ range: TsCellRange;
+ flags: TsRelFlags;
+ i, j: Integer;
+ c: TsCFCondition;
+ condition: Integer;
+ op1, op2: Variant;
+ fgColor, bgColor: TsColor;
+ fs, fill: TsFillStyle;
+ p: Integer;
+ L: TStrings;
+ sa: TStringArray;
+ fmt: TsCellFormat;
+ fmtIndex: Integer;
+ fntstyle: TsFontStyles;
+ fntColor: TsColor;
+ fnt: TsFont;
+ cb: TsCellBorder;
+ borders: TsCellBorders;
+ lineStyle: Integer;
+ lineColor: TsColor;
+ commonBorder: TsCellBorderStyle;
+ borderStyles: TsCellBorderStyles;
+begin
+ sheet := TsWorksheet(AWorksheet);
+ book := TsWorkbook(FWorkbook);
+
+ // initialize parameters
+ condition := -1;
+ range := fpsUtils.Range(Cardinal(-1), Cardinal(-1), Cardinal(-1), Cardinal(-1));
+ VarClear(op1);
+ VarClear(op2);
+ bgColor := scNotDefined;
+ fgColor := scNotDefined;
+ fill := fsNoFill;
+ fntStyle := [];
+ fntColor := scNotDefined;
+ commonBorder := NO_CELL_BORDER;
+ borderStyles[cbNorth] := NO_CELL_BORDER;
+ borderStyles[cbSouth] := NO_CELL_BORDER;
+ borderStyles[cbEast] := NO_CELL_BORDER;
+ borderStyles[cbWest] := NO_CELL_BORDER;
+ borders := [];
+
+ nodeName := ANode.NodeName; // for debugging
+
+ // Read nodes
+ while ANode <> nil do
+ begin
+ nodeName := ANode.NodeName;
+ if nodeName = 'Range' then
+ begin
+ s := GetNodeValue(ANode);
+ if not ParseCellRangeString_R1C1(s, 0, 0,
+ range.Row1, range.Col1, range.Row2, range.Col2, flags) then
+ begin
+ book.AddErrorMsg('Conditional format range %s not readable', [s]);
+ exit;
+ end;
+ end;
+
+ if nodeName = 'Condition' then
+ begin
+ childNode := ANode.FirstChild;
+ while childNode <> nil do
+ begin
+ nodeName := childNode.NodeName;
+ if nodeName = 'Qualifier' then
+ begin
+ s := GetNodeValue(childNode);
+ if (s <> '') and (s[1] <> '@') then
+ begin
+ for c in TsCFCondition do
+ if s = CF_CONDITIONS[c] then
+ begin
+ condition := ord(c);
+ break;
+ end;
+ end;
+ end else
+ if nodeName = 'Value1' then
+ begin
+ s := GetNodeValue(childNode);
+ if s <> '' then
+ op1 := s;
+ end else
+ if nodeName = 'Value2' then
+ begin
+ s := GetNodeValue(childNode);
+ if s <> '' then
+ op2 := s;
+ end else
+ if nodeName = 'Format' then
+ begin
+ s := GetAttrValue(childNode, 'Style');
+ L := TStringList.Create;
+ try
+ L.Delimiter := ';';
+ L.NameValueSeparator := ':';
+ L.StrictDelimiter := true;
+ L.DelimitedText := s;
+ for i := 0 to L.Count-1 do
+ begin
+ nameStr := Trim(L.Names[i]);
+ valueStr := Trim(L.ValueFromIndex[i]);
+ case nameStr of
+ 'background':
+ bgColor := HTMLColorStrToColor(valueStr);
+ 'mso-pattern':
+ for fs in TsFillStyle do
+ begin
+ p := pos(CF_FILL_NAMES[fs], valueStr);
+ if p > 0 then begin
+ fill := fs;
+ Delete(valueStr, p, Length(CF_FILL_NAMES[fs]));
+ fgColor := HTMLColorStrToColor(Trim(valueStr));
+ break;
+ end;
+ end;
+ 'font-style':
+ if valueStr = 'italic' then
+ fntStyle := fntStyle + [fssItalic];
+ 'font-weight':
+ if StrToInt(valueStr) > 500 then
+ fntStyle := fntStyle + [fssBold];
+ 'text-line-through':
+ fntStyle := fntStyle + [fssStrikeOut];
+ 'color':
+ fntColor := HTMLColorStrToColor(valueStr);
+ 'border', 'border-top', 'border-bottom', 'border-left', 'border-right':
+ begin
+ if nameStr = 'border' then
+ borders := ALL_BORDERS
+ else
+ begin
+ if not TryStrToCFCellBorder(nameStr, cb) then
+ Continue;
+ if valueStr = 'none' then
+ Continue;
+ end;
+ sa := valueStr.Split(' ');
+ lineColor := scNotDefined;
+ lineStyle := -1;
+ for j := 0 to High(sa) do begin
+ tmpStr := Trim(sa[j]);
+ // Line width not supported
+ if pos('pt', tmpStr) > 0 then
+ Continue;
+ // Extract line style
+ if (linestyle = -1) and TryStrToCFLineStyle(tmpStr, TsLineStyle(linestyle)) then
+ Continue;
+ // Extract line color
+ if (lineColor = scNotDefined) then
+ lineColor := HTMLColorStrToColor(tmpStr);
+ end;
+ if nameStr = 'border' then
+ begin
+ if linestyle = -1 then
+ commonBorder.LineStyle := lsThin
+ else
+ commonBorder.LineStyle := TsLineStyle(linestyle);
+ commonBorder.Color := lineColor;
+ end else
+ begin
+ Include(borders, cb);
+ if lineStyle = -1 then
+ borderStyles[cb].LineStyle := lsThin
+ else
+ borderStyles[cb].LineStyle := TsLineStyle(linestyle);
+ borderStyles[cb].Color := lineColor;
+ end;
+ end;
+ end;
+ end;
+ finally
+ L.Free;
+ end;
+ end;
+ childNode := childNode.NextSibling;
+ end;
+ end;
+ ANode := ANode.NextSibling;
+ end;
+
+ if (range.Row1 = Cardinal(-1)) or (range.Col1 = Cardinal(-1)) or
+ (range.Row2 = Cardinal(-1)) or (Range.Col2 = Cardinal(-1)) then
+ begin
+ book.AddErrorMsg('Missing cell range for conditional formatting.');
+ exit;
+ end;
+
+ if condition = Cardinal(-1) then
+ begin
+ book.AddErrorMsg('No condition given in conditional format.');
+ exit;
+ end;
+
+ // Prepare format record used by the conditional format
+ InitFormatRecord(fmt);
+ // ... background
+ if (bgColor <> scNotDefined) or (fgColor <> scNotDefined) or (fill <> fsNoFill) then
+ begin
+ if fgColor = scNotDefined then
+ fmt.SetBackgroundColor(bgColor)
+ else
+ fmt.SetBackground(fill, fgColor, bgColor);
+ end;
+ // ... font
+ if (fntStyle <> []) or (fntColor <> scNotDefined) then
+ begin
+ fnt := book.CloneFont(fmt.FontIndex);
+ if fntStyle <> [] then
+ fnt.Style := fntStyle;
+ if fntColor <> scNotDefined then
+ fnt.Color := fntColor;
+ fmt.SetFont(book.AddFont(fnt));
+ end;
+ // .. borders
+ if commonBorder.Color <> scNotDefined then
+ fmt.SetBorders(ALL_BORDERS, commonBorder.Color, commonBorder.LineStyle)
+ else
+ for cb in borders do
+ fmt.SetBorders([cb], borderStyles[cb].Color, borderStyles[cb].LineStyle);
+
+ // Add format record to format list
+ fmtIndex := book.AddCellFormat(fmt);
+
+ // Attach as conditional format to the given cell range of the worksheet
+ sheet.WriteConditionalCellFormat(range, TsCFCondition(condition), op1, op2, fmtIndex);
+end;
+
{@@ ----------------------------------------------------------------------------
Reads the "ExcelWorkbook" node
-------------------------------------------------------------------------------}
@@ -1409,7 +1696,9 @@ begin
else if nodeName = 'Names' then
ReadNames(ANode.FirstChild, AWorksheet)
else if nodeName = 'PageBreaks' then
- ReadPageBreaks(ANode.FirstChild, AWorksheet);
+ ReadPageBreaks(ANode.FirstChild, AWorksheet)
+ else if nodeName = 'ConditionalFormatting' then
+ ReadConditionalFormatting(ANode.FirstChild, AWorksheet);
ANode := ANode.NextSibling;
end;
end;
@@ -1752,12 +2041,12 @@ begin
Result := '';
end;
-function TsSpreadExcelXMLWriter.GetIndexStr(AIndex, APrevIndex: Integer): String;
+function TsSpreadExcelXMLWriter.GetIndexStr(AIndex, APrevIndex: Cardinal): String;
begin
- if (APrevIndex = -1) and (AIndex = 0) then
+ if (APrevIndex = Cardinal(-1)) and (AIndex = 0) then
Result := ''
else
- if (APrevIndex >= 0) and (AIndex = APrevIndex + 1) then
+ if {(APrevIndex >= 0) and} (AIndex = APrevIndex + 1) then
Result := ''
else
Result := Format(' ss:Index="%d"', [AIndex + 1]);
@@ -2055,7 +2344,14 @@ procedure TsSpreadExcelXMLWriter.WriteConditionalFormat(AStream: TStream;
Result := '';
if not (uffBackground in AFormat.UsedFormattingFields) then
exit;
- Result := Format('background:%s;', [ColorToHTMLColorStr(AFormat.Background.BgColor)]);
+ if AFormat.Background.Style = fsSolidFill then
+ Result := Format('background:%s;', [ColorToHTMLColorStr(AFormat.Background.BgColor)])
+ else
+ Result := Format('background:%s;mso-pattern:%s %s;', [
+ ColorToHTMLColorStr(AFormat.Background.BgColor),
+ CF_FILL_NAMES[AFormat.Background.Style],
+ ColorToHTMLColorStr(AFormat.Background.FgColor)
+ ]);
end;
function BorderStyle(AFormat: TsCellFormat): String;
@@ -2071,33 +2367,52 @@ procedure TsSpreadExcelXMLWriter.WriteConditionalFormat(AStream: TStream;
if allEqual then begin
bs := AFormat.BorderStyles[cbEast];
for cb in TsCellBorders do
- if (AFormat.BorderStyles[cb].Color <> bs.Color) or
- (AFormat.BorderStyles[cb].LineStyle <> bs.LineStyle) then
- begin
- allEqual := false;
- break;
- end;
+ if not (cb in [cbDiagUp, cbDiagDown]) then
+ if (AFormat.BorderStyles[cb].Color <> bs.Color) or
+ (AFormat.BorderStyles[cb].LineStyle <> bs.LineStyle) then
+ begin
+ allEqual := false;
+ break;
+ end;
end;
if allEqual then
Result := Format('border:0.5pt %s %s;', [
- //LINE_WIDTHS[bs.LineStyle]*0.5,
- LINE_STYLES1[bs.LineStyle],
+ CF_LINE_STYLES[bs.LineStyle],
ColorToHTMLColorStr(bs.Color)
])
else
for cb in TsCellBorders do
begin
+ if cb in [cbDiagUp, cbDiagDown] then
+ Continue;
bs := AFormat.BorderStyles[cb];
if (cb in AFormat.Border) then
Result := Result + Format('border-%s:0.5pt %s %s;', [
Lowercase(BORDER_NAMES[cb]),
- //LINE_WIDTHS[bs.LineStyle]*0.5,
- LINE_STYLES1[bs.LineStyle],
+ CF_LINE_STYLES[bs.LineStyle],
ColorToHTMLColorStr(bs.Color)
]);
end;
end;
+ function FontStyle(AFormat: TsCellFormat): String;
+ var
+ fnt: TsFont;
+ begin
+ Result := '';
+ if not (uffFont in AFormat.UsedFormattingFields) then
+ exit;
+ fnt := TsWorkbook(FWorkbook).GetFont(AFormat.FontIndex);
+ if (fssItalic in fnt.Style) then
+ Result := Result + 'font-style:italic;';
+ if (fssBold in fnt.Style) then
+ Result := Result + 'font-weight:700;';
+ if (fssStrikeOut in fnt.Style) then
+ Result := Result + 'text-line-through:single;';
+ if fnt.Color <> scNotDefined then
+ Result := Result + 'color:' + ColorToHTMLColorStr(fnt.Color) + ';';
+ end;
+
var
rangeStr: String;
cfRule: TsCFCellRule;
@@ -2183,10 +2498,13 @@ begin
'' + value2Str + '');
fmt := book.GetCellFormat(cfRule.FormatIndex);
- s := BackgroundStyle(fmt) + BorderStyle(fmt);
+ s := BackgroundStyle(fmt) + BorderStyle(fmt) + FontStyle(fmt);
if s <> '' then
+ begin
+ if s[Length(s)] = ';' then Delete(s, Length(s), 1);
AppendToStream(AStream, LF + INDENT4 +
'');
+ end;
AppendToStream(AStream, LF + INDENT3 +
''
diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas
index a3ec0f48c..89c3107de 100644
--- a/components/fpspreadsheet/source/common/xlsxooxml.pas
+++ b/components/fpspreadsheet/source/common/xlsxooxml.pas
@@ -2068,25 +2068,11 @@ begin
while childNode <> nil do
begin
nodeName := childNode.NodeName;
- if nodeName = 'left' then
- begin
- borders := borders + [cbWest];
- ReadBorderStyle(childNode, borderStyles[cbWest]);
- end else
- if nodeName = 'top' then
- begin
- borders := borders + [cbNorth];
- ReadBorderStyle(childNode, borderStyles[cbNorth]);
- end else
- if nodeName = 'right' then
- begin
- borders := borders + [cbEast];
- ReadBorderStyle(childNode, borderStyles[cbEast]);
- end else
- if nodeName = 'bottom' then
- begin
- borders := borders + [cbSouth];
- ReadBorderStyle(childNode, borderStyles[cbSouth]);
+ case nodeName of
+ 'left': if ReadBorderStyle(childNode, borderStyles[cbWest]) then Include(borders, cbWest);
+ 'right': if ReadBorderStyle(childNode, borderStyles[cbEast]) then Include(borders, cbEast);
+ 'top': if ReadBorderStyle(childNode, borderStyles[cbNorth]) then Include(borders, cbNorth);
+ 'bottom': if ReadBorderStyle(childNode, borderStyles[cbSouth]) then Include(borders, cbSouth);
end;
childNode := childNode.NextSibling;
end;
diff --git a/components/fpspreadsheet/tests/conditionalformattests.pas b/components/fpspreadsheet/tests/conditionalformattests.pas
index ab125e8be..6e7f67ea6 100644
--- a/components/fpspreadsheet/tests/conditionalformattests.pas
+++ b/components/fpspreadsheet/tests/conditionalformattests.pas
@@ -41,6 +41,7 @@ type
FullSyntax: Boolean);
published
+ { Excel XLSX }
procedure TestWriteRead_CF_CellFmt_XLSX_Equal_Const;
procedure TestWriteRead_CF_CellFmt_XLSX_NotEqual_Const;
procedure TestWriteRead_CF_CellFmt_XLSX_GreaterThan_Const;
@@ -69,7 +70,8 @@ type
procedure TestWriteRead_CF_CellFmt_XLSX_NotContainsErrors;
procedure TestWriteRead_CF_CellFmt_XLSX_Expression;
procedure TestWriteRead_CF_CellFmt_XLSX_Background;
- procedure TestWriteRead_CF_CellFmt_XLSX_Border;
+ procedure TestWriteRead_CF_CellFmt_XLSX_Border4;
+ procedure TestWriteRead_CF_CellFmt_XLSX_Border2;
procedure TestWriteRead_CF_ColorRange_XLSX_3C_Full;
procedure TestWriteRead_CF_ColorRange_XLSX_2C_Full;
@@ -79,6 +81,20 @@ type
procedure TestWriteRead_CF_Databars_XLSX_Full;
procedure TestWriteRead_CF_Databars_XLSX_Simple;
+ { Excel XML }
+ procedure TestWriteRead_CF_CellFmt_XML_Equal_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_NotEqual_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_GreaterThan_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_LessThan_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_GreaterEqual_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_LessEqual_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_Between_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_NotBetween_Const;
+ procedure TestWriteRead_CF_CellFmt_XML_Background;
+ procedure TestWriteRead_CF_CellFmt_XML_Border4;
+ procedure TestWriteRead_CF_CellFmt_XML_Border2;
+ procedure TestWriteRead_CF_CellFmt_XML_Font;
+
end;
implementation
@@ -128,6 +144,9 @@ procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt(
const
SHEET_NAME = 'CF';
TEXTS: array[0..6] of String = ('abc', 'def', 'ghi', 'abc', 'jkl', 'akl', 'ab');
+ FONT_STYLE = [fssBold, fssItalic];
+ FONT_COLOR = scGreen;
+ NUMBER_FORMAT = '0.000';
var
worksheet: TsWorksheet;
workbook: TsWorkbook;
@@ -135,10 +154,12 @@ var
tempFile: string;
sollFmtIdx: Integer;
sollRange: TsCellRange;
+ sollFont: TsFont = nil;
actFMT: TsCellFormat;
actFmtIdx: Integer;
actRange: TsCellRange;
actCondition: TsCFCondition;
+ actFont: TsFont;
actValue1, actValue2: Variant;
cf: TsConditionalFormat;
begin
@@ -146,7 +167,7 @@ begin
workbook := TsWorkbook.Create;
try
workbook.Options := [boAutoCalc];
- workSheet:= workBook.AddWorksheet(SHEET_NAME);
+ worksheet:= workBook.AddWorksheet(SHEET_NAME);
row := 0;
for Col := 0 to High(TEXTS) do
@@ -158,6 +179,13 @@ begin
worksheet.WriteFormula(row, col, '=1/0');
// Write format used by the cells detected by conditional formatting
+ if ACellFormat.FontIndex = MaxInt then
+ begin
+ ACellFormat.SetFont(workbook.AddFont(workbook.GetDefaultFont.FontName, workbook.GetDefaultFont.Size, FONT_STYLE, FONT_COLOR));
+ sollFont := workbook.CloneFont(ACellFormat.FontIndex);
+ end;
+ if ACellFormat.NumberFormatIndex = MaxInt then
+ ACellFormat.SetNumberFormat(workbook.AddNumberFormat(NUMBER_FORMAT));
sollFmtIdx := workbook.AddCellFormat(ACellFormat);
// Write instruction for conditional formatting
@@ -248,6 +276,9 @@ begin
actFmt := workbook.GetCellFormat(actFmtIdx);
// - formatting fields
+ WriteLn(Integer(ACellFormat.UsedFormattingFields));
+ WriteLn(Integer(actfmt.UsedFormattingFields));
+
CheckEquals(integer(ACellFormat.UsedFormattingFields), integer(actFmt.UsedFormattingFields), 'Conditional formatting fields mismatch');
// - background
@@ -311,26 +342,50 @@ begin
// - fonts // not working for xlsx
if (uffFont in ACellFormat.UsedFormattingFields) then
begin
- if AFileFormat <> sfOOXML then
- begin
- end;
+ actFont := workbook.GetFont(actFmt.FontIndex);
+ CheckEquals(
+ sollFont.FontName,
+ actFont.Fontname,
+ 'Conditional format font name mismatch'
+ );
+ CheckEquals(
+ sollFont.Size,
+ actFont.Size,
+ 'Conditional format font size mismatch'
+ );
+ CheckEquals(
+ Integer(sollFont.Style),
+ Integer(actFont.Style),
+ 'Conditional format font style mismatch'
+ );
+ CheckEquals(
+ Integer(sollFont.Color),
+ Integer(actFont.Color),
+ 'Conditional format font color mismatch'
+ );
end;
// - Number format // not yet implemented for xlsx
- if (uffNumberFormat in ACEllFormat.UsedFormattingFields) then
+ if (uffNumberFormat in ACellFormat.UsedFormattingFields) then
begin
- if AFileFormat <> sfOOXML then
- begin
- end;
+ CheckEquals(
+ NUMBER_FORMAT,
+ workbook.GetNumberFormat(actFmt.NumberFormatIndex).NumFormatStr,
+ 'Conditional number format mismatch'
+ );
end;
end;
finally
workbook.Free;
+ sollFont.Free;
DeleteFile(tempFile);
end;
end;
+
+{ Excel XLSX }
+
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XLSX_Equal_Const;
var
fmt: TsCellFormat;
@@ -583,7 +638,7 @@ begin
TestWriteRead_CF_CellFmt(sfOOXML, cfcEqual, 5, fmt);
end;
-procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XLSX_Border;
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XLSX_Border4;
var
fmt: TsCellFormat;
begin
@@ -592,6 +647,16 @@ begin
TestWriteRead_CF_CellFmt(sfOOXML, cfcEqual, 5, fmt);
end;
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XLSX_Border2;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBorders([cbNorth,cbSouth], scBlue, lsDashed);
+ TestWriteRead_CF_CellFmt(sfOOXML, cfcEqual, 5, fmt);
+end;
+
+
{-------------------------------------------------------------------------------
Color range tests
--------------------------------------------------------------------------------}
@@ -875,6 +940,117 @@ begin
end;
+{ Excel XML }
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Equal_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_NotEqual_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcNotEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_GreaterThan_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcGreaterThan, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_LessThan_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcLessThan, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_GreaterEqual_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcGreaterEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_LessEqual_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcLessEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Between_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcBetween, 3, 7, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_NotBetween_Const;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackgroundColor(scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcNotBetween, 3, 7, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Background;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBackground(fsHatchDiag, scYellow, scRed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Border4;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBorders([cbNorth, cbEast, cbSouth, cbWest], scBlue, lsDotted);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Border2;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.SetBorders([cbNorth,cbSouth], scBlue, lsDashed);
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcEqual, 5, fmt);
+end;
+
+procedure TSpreadWriteReadCFTests.TestWriteRead_CF_CellFmt_XML_Font;
+var
+ fmt: TsCellFormat;
+begin
+ InitFormatRecord(fmt);
+ fmt.FontIndex := MaxInt; // Indicator for the test routine to create a predefined font
+ TestWriteRead_CF_CellFmt(sfExcelXML, cfcEqual, 5, fmt);
+end;
+
+
initialization
RegisterTest(TSpreadWriteReadCFTests);
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index 6c7939775..c1922ef74 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -14,8 +14,43 @@
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -193,11 +228,6 @@
-
-
-
-
-