From 2793744bf7dec5acdf9b0cf687d580bc6f017568 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 17 Jul 2020 19:50:40 +0000 Subject: [PATCH] fpspreadsheet: Add reading and writing support for conditional formats in Excel XML files (not yet complete). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7549 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../demo_conditional_formatting.pas | 6 +- .../fpspreadsheet/source/common/fpstypes.pas | 8 + .../fpspreadsheet/source/common/fpsutils.pas | 3 + .../fpspreadsheet/source/common/xlsxml.pas | 354 +++++++++++++++++- .../fpspreadsheet/source/common/xlsxooxml.pas | 24 +- .../tests/conditionalformattests.pas | 196 +++++++++- .../fpspreadsheet/tests/spreadtestgui.lpi | 42 ++- 7 files changed, 578 insertions(+), 55 deletions(-) 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 @@ - - - - -