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

fpspreadsheet: Add reading and writing support for conditional formats in Excel XML files (not yet complete).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7549 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-17 19:50:40 +00:00
parent 6aa2860020
commit 2793744bf7
7 changed files with 578 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
View File

@ -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);

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

@ -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;

3
components/fpspreadsheet/source/common/fpsutils.pas
View File

@ -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);

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

@ -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
'<Value2>' + value2Str + '</Value2>');
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 +
'<Format Style=''' + s + '''/>');
end;
AppendToStream(AStream, LF + INDENT3 +
'</Condition>'

24
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -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;

196
components/fpspreadsheet/tests/conditionalformattests.pas
View File

@ -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);

42
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -14,8 +14,43 @@
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<BuildModes Count="2">
<Item1 Name="Default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="spreadtestgui"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\source;$(ProjOutDir)"/>
<OtherUnitFiles Value="..\source\common"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</Item2>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -193,11 +228,6 @@
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<OtherDefines Count="1">
<Define0 Value="FormulaDebug"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="7">