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 9f5480da4..b07aa5ad7 100644 --- a/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas +++ b/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas @@ -3,7 +3,7 @@ program demo_conditional_formatting; uses sysUtils, fpsTypes, fpsUtils, fpspreadsheet, fpsConditionalFormat, - xlsxooxml, fpsOpenDocument; + xlsxooxml, xlsxml, fpsOpenDocument; var wb: TsWorkbook; @@ -91,6 +91,7 @@ begin inc(row); sh.WriteText(row, 0, 'greater equal constant 5'); sh.WriteText(row, 1, 'background gray'); + InitFormatRecord(fmt); fmt.SetBackgroundColor(scGray); fmtIdx := wb.AddCellFormat(fmt); sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcGreaterEqual, 5, fmtIdx); @@ -103,7 +104,7 @@ begin // conditional format #6: between inc(row); - sh.WriteText(row, 0, 'between 3 and 7'); + sh.WriteText(row, 0, 'between 2 and 7'); sh.WriteText(row, 1, 'background light gray'); fmt.SetBackgroundColor($EEEEEE); fmtIdx := wb.AddCellFormat(fmt); @@ -111,7 +112,7 @@ begin // conditional format #6: not between inc(row); - sh.WriteText(row, 0, 'not between 3 and 7'); + sh.WriteText(row, 0, 'not between 2 and 7'); sh.WriteText(row, 1, 'background light gray'); sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcNotBetween, 2, 7, fmtIdx); @@ -306,6 +307,14 @@ begin { ------ Save workbook to file-------------------------------------------- } wb.WriteToFile('test.xlsx', true); wb.WriteToFile('test.ods', true); + wb.WriteToFile('test.xml', true); + + if wb.ErrorMsg <> '' then begin + WriteLn(wb.ErrorMsg); + WriteLn; + WriteLn('Press ENTER to close.'); + ReadLn; + end; finally wb.Free; end; diff --git a/components/fpspreadsheet/source/common/fpsexprparser.pas b/components/fpspreadsheet/source/common/fpsexprparser.pas index 10a99c72c..ad0de5341 100644 --- a/components/fpspreadsheet/source/common/fpsexprparser.pas +++ b/components/fpspreadsheet/source/common/fpsexprparser.pas @@ -4108,8 +4108,12 @@ begin fdExcelA1, fdLocalized: Result := Format('%s!%s', [GetQuotedSheetName, GetCellString(r, c, FFlags)]); fdExcelR1C1: - Result := Format('%s!%s', [GetQuotedSheetName, - GetCellString_R1C1(r, c, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col)]); + if FParser.FSourceCell = nil then + Result := Format('%s!%s', [GetQuotedSheetName, + GetCellString_R1C1(r, c, [])]) + else + Result := Format('%s!%s', [GetQuotedSheetName, + GetCellString_R1C1(r, c, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col)]); fdOpenDocument: begin s := GetQuotedSheetName; @@ -4122,7 +4126,10 @@ begin fdExcelA1, fdLocalized: Result := GetCellString(GetRow, GetCol, FFlags); fdExcelR1C1: - Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col); + if FParser.FSourceCell = nil then + Result := GetCellString_R1C1(GetRow, GetCol, []) + else + Result := GetCellString_R1C1(GetRow, GetCol, FFlags, FParser.FSourceCell^.Row, FParser.FSourceCell^.Col); fdOpenDocument: Result := '[.' + GetCellString(GetRow, GetCol, FFlags) + ']'; end; diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index ebd7c0ebe..9d7490e51 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -450,7 +450,6 @@ end; type - { Table style items stored in TableStyleList of the reader } TTableStyleData = class public diff --git a/components/fpspreadsheet/source/common/xlsxml.pas b/components/fpspreadsheet/source/common/xlsxml.pas index 9cd6edd86..1853deaf6 100644 --- a/components/fpspreadsheet/source/common/xlsxml.pas +++ b/components/fpspreadsheet/source/common/xlsxml.pas @@ -23,7 +23,7 @@ interface uses Classes, SysUtils, laz2_xmlread, laz2_DOM, - fpsTypes, fpsReaderWriter, fpsXMLCommon, xlsCommon; + fpsTypes, fpsReaderWriter, fpsConditionalFormat, fpsXMLCommon, xlsCommon; type { TsSpreadExcelXMLReader } @@ -91,6 +91,9 @@ type function GetStyleStr(AFormatIndex: Integer): String; procedure WriteCellNodes(AStream: TStream; AWorksheet: TsBasicWorksheet; ARow: Cardinal); procedure WriteColumns(AStream: TStream; AWorksheet: TsBasicWorksheet); + procedure WriteConditionalFormat(AStream: TStream; AWorksheet: TsBasicWorksheet; + AFormat: TsConditionalFormat); + procedure WriteConditionalFormatting(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteExcelWorkbook(AStream: TStream); procedure WriteNames(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WritePageBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); @@ -141,7 +144,7 @@ var implementation uses - StrUtils, DateUtils, Math, Variants, + StrUtils, DateUtils, Math, Variants, TypInfo, fpsStrings, fpsClasses, fpspreadsheet, fpsUtils, fpsNumFormat, fpsHTMLUtils, fpsExprParser; @@ -193,6 +196,13 @@ const 'Dash', 'DashDot', 'DashDot', 'DashDotDot', 'DashDotDot', 'SlantDashDot' ); + + LINE_STYLES1: array[TsLineStyle] of string = ( + 'solid', 'solid', 'dashed', 'dotted', 'solid', 'double', 'hairline', + 'dashed', 'dot-dash', 'dot-dash', 'dot-dot-dash', 'dot-dot-dash', + 'dot-dash' + ); + LINE_WIDTHS: array[TsLineStyle] of Integer = ( 1, 2, 1, 1, 3, 3, 0, 2, 1, 2, 1, 2, @@ -201,6 +211,28 @@ const FALSE_TRUE: array[boolean] of string = ('False', 'True'); + CF_CONDITIONS: array[TsCFCondition] of string = ( + 'Equal', 'NotEqual', // cfcEqual, cfcNotEqual, + 'Greater', 'Less', 'GreaterOrEqual', 'LessOrEqual', // cfcGreaterThan, cfcLessThan, cfcGreaterEqual, cfcLessEqual, + 'Between', 'NotBetween', // cfcBetween, cfcNotBetween, + // the following 4 formulas are copies of Excel-generated files, but do not work... + '', //'@RC>AVERAGE( IF(ISERROR(%2:s), "", IF(ISBLANK(%2:s), "", %2:s)))', // cfcAboveAverage + '', //'@RC<AVERAGE( IF(ISERROR(%2:s), "", IF(ISBLANK(%2:s), "", %2:s)))', // cfcBelowAverage + '', //'@RC>=AVERAGE( IF(ISERROR(%2:s), "", IF(ISBLANK(%2:s), "", %2:s)))', // cfcAboveEqualAverage + '', //'@RC<=AVERAGE( IF(ISERROR(%2:s), "", IF(ISBLANK(%2:s), "", %2:s)))', // cfcBelowEqualAverage + // The next 4 formulas are not supported by Excel-XML + '', '', '', '', // cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent, + '@AND(COUNTIF(%2:s, RC)>1,NOT(ISBLANK(RC)))', // cfcDuplicate + '@AND(COUNTIF(%2:s, RC)=1,NOT(ISBLANK(RC)))', // cfcUnique + '@LEFT(RC,LEN(%0:s))=%0:s', // cfcBeginsWith + '@RIGHT(RC,LEN(%0:s))=%0:s', // cfcEndsWith + '@NOT(ISERROR(SEARCH(%0:s,RC)))', // cfcContainsText + '@ISERROR(SEARCH(%0:s,RC))', // cfcNotContainsText, + '@ISERROR(RC)', // cfcContainsErrors + '@NOT(ISERROR(RC))' // cfcNotContainsErrors + ); + // The leading '@' indicates that the formula will be used in node + function GetCellContentTypeStr(ACell: PCell): String; begin case ACell^.ContentType of @@ -241,6 +273,36 @@ begin end; end; +function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String; +var + r,c: Cardinal; + parser: TsSpreadsheetParser; +begin + Result := VarToStr(v); + if Result = '' then + exit; + + if VarIsStr(v) then begin + // Special case: v is a formula, i.e. begins with '=' + if (Length(Result) > 1) and (Result[1] = '=') then + begin + parser := TsSpreadsheetParser.Create(AWorksheet); + try + parser.Expression[fdExcelA1] := Result; // Parse in Excel-A1 dialect + Result := parser.R1C1Expression[nil]; // Convert to R1C1 dialect + // Note: Using nil here to get absolute references. + finally + parser.Free; + end; + end + else + // Special case: cell reference (Note: relative refs are made absolute!) + if ParseCellString(Result, r, c) then + Result := GetCellString_R1C1(r, c, []) // Need absolute reference! + else + Result := UTF8TextToXMLText(SafeQuoteStr(Result)) + end; +end; {=============================================================================== TsSpreadExcelXMLReader @@ -1976,6 +2038,160 @@ begin end; end; +procedure TsSpreadExcelXMLWriter.WriteConditionalFormat(AStream: TStream; + AWorksheet: TsBasicWorksheet; AFormat: TsConditionalFormat); + + function BackgroundStyle(AFormat: TsCellFormat): String; + begin + Result := ''; + if not (uffBackground in AFormat.UsedFormattingFields) then + exit; + Result := Format('background:%s;', [ColorToHTMLColorStr(AFormat.Background.BgColor)]); + end; + + function BorderStyle(AFormat: TsCellFormat): String; + var + cb: TsCellBorder; + allEqual: Boolean; + bs: TsCellBorderStyle; + begin + Result := ''; + if not (uffBorder in AFormat.UsedFormattingFields) then + exit; + allEqual := ([cbEast, cbWest, cbNorth, cbSouth] = AFormat.Border); + 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; + end; + if allEqual then + Result := Format('border:0.5pt %s %s;', [ + //LINE_WIDTHS[bs.LineStyle]*0.5, + LINE_STYLES1[bs.LineStyle], + ColorToHTMLColorStr(bs.Color) + ]) + else + for cb in TsCellBorders do + begin + 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], + ColorToHTMLColorStr(bs.Color) + ]); + end; + end; + +var + rangeStr: String; + cfRule: TsCFCellRule; + i: Integer; + value1Str, value2Str: String; + sheet: TsWorksheet; + book: TsWorkbook; + fmt: TsCellFormat; + s: String; + needToExit: Boolean; +begin + book := TsWorkbook(FWorkbook); + sheet := TsWorksheet(AWorksheet); + + needToExit := false; + for i := 0 to AFormat.RulesCount-1 do + if not (AFormat.Rules[i] is TsCFCellRule) then + begin + FWorkbook.AddErrorMsg('Conditional formatting rule ' + AFormat.Rules[i].ClassName + ' not supported by Excel-XML.'); + needToExit := true; + end; + + if needToExit then + exit; + + AppendToStream(AStream, INDENT2 + + ''); + + with AFormat.CellRange do + rangeStr := GetCellRangeString_R1C1(Row1, Col1, Row2, Col2, [], Row1, Col1); + AppendToStream(AStream, LF + INDENT3 + + '' + rangeStr + ''); + + for i := 0 to AFormat.RulesCount-1 do + begin + if AFormat.Rules[i] is TsCFCellRule then + begin + cfRule := TsCFCellRule(AFormat.Rules[i]); + if CF_CONDITIONS[cfRule.Condition] = '' then + begin + s := GetEnumName(TypeInfo(TsCFCondition), Ord(cfRule.Condition)); + FWorkbook.AddErrorMsg('Conditional formatting rule "' + s + '" not supported by ExcelXML.'); + Continue; + end; + + value1Str := CFOperandToStr(cfRule.Operand1, sheet); + value2Str := CFOperandToStr(cfRule.Operand2, sheet); + + s := CF_CONDITIONS[cfRule.Condition]; + if s[1] = '@' then + begin + Delete(s, 1,1); + s := Format(s, [value1Str, value2Str, rangeStr]); + value1Str := s; + s := ''; + end; + + AppendToStream(AStream, LF + INDENT3 + + ''); + + if s <> '' then + AppendToStream(AStream, LF + INDENT4 + + '' + s + ''); + if value1Str <> '' then + AppendToStream(AStream, LF + INDENT4 + + '' + value1Str + ''); + if (cfRule.Condition in [cfcBetween, cfcNotBetween]) and (value2Str <> '') then + AppendToStream(AStream, LF + INDENT4 + + '' + value2Str + ''); + + fmt := book.GetCellFormat(cfRule.FormatIndex); + s := BackgroundStyle(fmt) + BorderStyle(fmt); + if s <> '' then + AppendToStream(AStream, LF + INDENT4 + + ''); + + AppendToStream(AStream, LF + INDENT3 + + '' + ); + end; + end; + + AppendToStream(AStream, LF + INDENT2 + + '' + LF); +end; + +procedure TsSpreadExcelXMLWriter.WriteConditionalFormatting(AStream: TStream; + AWorksheet: TsBasicWorksheet); +var + book: TsWorkbook; + sheet: TsWorksheet; + cf: TsConditionalFormat; + i: Integer; +begin + book := TsWorkbook(FWorkbook); + sheet := TsWorksheet(AWorksheet); + for i := 0 to book.GetNumConditionalFormats-1 do + begin + cf := book.GetConditionalFormat(i); + WriteConditionalFormat(AStream, AWorksheet, cf); + end; +end; + procedure TsSpreadExcelXMLWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); var @@ -2637,6 +2853,7 @@ begin WriteNames(AStream, AWorksheet); WriteTable(AStream, AWorksheet); WriteWorksheetOptions(AStream, AWorksheet); + WriteConditionalFormatting(AStream, AWorksheet); WritePageBreaks(AStream, AWorksheet); AppendToStream(AStream, ' ' + LF