From f3437814bfea7d764843f8f7d9f826f41d6ad2e2 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 2 Jul 2020 10:53:42 +0000 Subject: [PATCH] fpspreadsheet: Add writing of color range conditional formatting to XLSX. Support 2-color mode in color ranges. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7520 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../demo_conditional_formatting.pas | 8 +- .../source/common/fpsconditionalformat.pas | 41 ++++- .../source/common/fpsopendocument.pas | 46 ++++-- .../source/common/fpspreadsheet.pas | 9 +- .../source/common/fpspreadsheet_cf.inc | 21 ++- .../fpspreadsheet/source/common/xlsxooxml.pas | 148 ++++++++---------- 6 files changed, 164 insertions(+), 109 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 a9d077436..8c1000958 100644 --- a/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas +++ b/components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas @@ -289,7 +289,7 @@ begin // Databar inc(row); sh.WriteText(row, 0, 'Data bar'); - sh.WriteDatabars(Range(Row, 2, row, 12)); + //sh.WriteDatabars(Range(Row, 2, row, 12)); // ColorRange inc(row); @@ -297,6 +297,12 @@ begin sh.WriteText(row, 1, 'yellow -> blue -> red'); sh.WriteColorRange(Range(Row, 2, row, 12), scYellow, scBlue, scRed); + // ColorRange + inc(row); + sh.WriteText(row, 0, 'Color Range'); + sh.WriteText(row, 1, 'yellow -> red'); + sh.WriteColorRange(Range(Row, 2, row, 12), scYellow, scRed); + { ------ Save workbook to file-------------------------------------------- } wb.WriteToFile('test.xlsx', true); wb.WriteToFile('test.ods', true); diff --git a/components/fpspreadsheet/source/common/fpsconditionalformat.pas b/components/fpspreadsheet/source/common/fpsconditionalformat.pas index 191d93c00..961a7bf7c 100644 --- a/components/fpspreadsheet/source/common/fpsconditionalformat.pas +++ b/components/fpspreadsheet/source/common/fpsconditionalformat.pas @@ -36,7 +36,7 @@ type end; { Color range } - TsCFColorRangeValueKind = (crvkMin, crvkMax, crvkPercent, crkValue); + TsCFColorRangeValueKind = (crvkMin, crvkMax, crvkPercent, crvkValue); TsCFColorRangeRule = class(TsCFRule) StartValueKind: TsCFColorRangeValueKind; @@ -48,6 +48,7 @@ type StartColor: TsColor; CenterColor: TsColor; EndColor: TsColor; + ThreeColors: Boolean; constructor Create; procedure Assign(ASource: TsCFRule); override; procedure SetupEnd(AColor: TsColor; AKind: TsCFColorRangeValueKind; AValue: Double); @@ -100,13 +101,21 @@ type ACondition: TsCFCondition; AParam: Variant; ACellFormatIndex: Integer): Integer; overload; function AddCellRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; ACondition: TsCFCondition; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload; + + function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; + AStartColor, AEndColor: TsColor): Integer; overload; function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; AStartColor, ACenterColor, AEndColor: TsColor): Integer; overload; + function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; + AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; + AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; overload; function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double; AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; overload; + function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer; + procedure Delete(AIndex: Integer); function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer; end; @@ -141,6 +150,7 @@ end; constructor TsCFColorRangeRule.Create; begin inherited; + ThreeColors := true; SetupStart(scRed, crvkMin, 0.0); SetupCenter(scYellow, crvkPercent, 50.0); SetupEnd(scBlue, crvkMax, 0.0); @@ -153,6 +163,7 @@ procedure TsCFColorRangeRule.Assign(ASource: TsCFRule); begin if ASource is TsCFColorRangeRule then begin + ThreeColors := TsCFColorRangeRule(ASource).ThreeColors; StartValueKind := TsCFColorRangeRule(ASource).StartValueKind; CenterValueKind := TsCFColorRangeRule(ASource).CenterValueKind; EndValueKind := TsCFColorRangeRule(ASource).EndValueKind; @@ -319,6 +330,33 @@ begin rule.StartColor := AStartColor; rule.CenterColor := ACenterColor; rule.EndColor := AEndColor; + rule.ThreeColors := true; + Result := AddRule(ASheet, ARange, rule); +end; + +function TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet; + ARange: TsCellRange; AStartColor, AEndColor: TsColor): Integer; +var + rule: TsCFColorRangeRule; +begin + rule := TsCFColorRangeRule.Create; + rule.StartColor := AStartColor; + rule.EndColor := AEndColor; + rule.ThreeColors := false; + Result := AddRule(ASheet, ARange, rule); +end; + +function TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet; + ARange: TsCellRange; + AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; + AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; +var + rule: TsCFColorRangeRule; +begin + rule := TsCFColorRangeRule.Create; + rule.SetupStart(AStartColor, AStartKind, AStartValue); + rule.SetupEnd(AEndColor, AEndKind, AEndValue); + rule.ThreeColors := false; Result := AddRule(ASheet, ARange, rule); end; @@ -334,6 +372,7 @@ begin rule.SetupStart(AStartColor, AStartKind, AStartValue); rule.SetupCenter(ACenterColor, ACenterKind, ACenterValue); rule.SetupEnd(AEndColor, AEndKind, AEndValue); + rule.ThreeColors := true; Result := AddRule(ASheet, ARange, rule); end; diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index 95fe896d6..5634a90ef 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -5961,22 +5961,36 @@ begin if cf.Rules[j] is TsCFColorRangeRule then begin cf_ColorRangeRule := TsCFColorRangeRule(cf.Rules[j]); - AppendToStream(AStream, Format( - '' + - '' + - '' + - '' + - '', [ - cf_ColorRangeRule.StartValue, - CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind], - ColorToHTMLColorStr(cf_ColorRangeRule.StartColor), - cf_ColorRangeRule.CenterValue, - CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.CenterValueKind], - ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor), - cf_ColorRangeRule.EndValue, - CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind], - ColorToHTMLColorStr(cf_ColorRangeRule.EndColor) - ])); + if cf_ColorRangeRule.ThreeColors then + AppendToStream(AStream, Format( + '' + + '' + + '' + + '' + + '', [ + cf_ColorRangeRule.StartValue, + CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind], + ColorToHTMLColorStr(cf_ColorRangeRule.StartColor), + cf_ColorRangeRule.CenterValue, + CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.CenterValueKind], + ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor), + cf_ColorRangeRule.EndValue, + CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind], + ColorToHTMLColorStr(cf_ColorRangeRule.EndColor) + ])) + else + AppendToStream(AStream, Format( + '' + + '' + + '' + + '', [ + cf_ColorRangeRule.StartValue, + CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind], + ColorToHTMLColorStr(cf_ColorRangeRule.StartColor), + cf_ColorRangeRule.EndValue, + CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind], + ColorToHTMLColorStr(cf_ColorRangeRule.EndColor) + ])); end; end; diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas index 5ac30ab92..2a6f48ffa 100644 --- a/components/fpspreadsheet/source/common/fpspreadsheet.pas +++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas @@ -392,8 +392,13 @@ type function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload; // color range - function WriteColorRange(ARange: TsCellRange; AStartColor: TsColor = scRed; - ACenterColor: TsColor = scYellow; AEndColor: TsColor = scBlue): Integer; overload; + function WriteColorRange(ARange: TsCellRange; + AStartColor, AEndColor: TsColor): Integer; overload; + function WriteColorRange(ARange: TsCellRange; + AStartColor, ACenterColor, AEndColor: TsColor): Integer; overload; + function WriteColorRange(ARange: TsCellRange; + AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; + AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; overload; function WriteColorRange(ARange: TsCellRange; AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double; diff --git a/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc index a868a72d5..dbc7d7b93 100644 --- a/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc +++ b/components/fpspreadsheet/source/common/fpspreadsheet_cf.inc @@ -69,14 +69,31 @@ end; Writes the conditional format "color range" -------------------------------------------------------------------------------} function TsWorksheet.WriteColorRange(ARange: TsCellRange; - AStartColor: TsColor = scRed; ACenterColor: TsColor = scYellow; - AEndColor: TsColor = scBlue): Integer; + AStartColor, AEndColor: TsColor): Integer; +begin + Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange, + AStartColor, AEndColor); + StoreCFIndexInCells(Self, Result, ARange); +end; + +function TsWorksheet.WriteColorRange(ARange: TsCellRange; + AStartColor, ACenterColor, AEndColor: TsColor): Integer; begin Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange, AStartColor, ACenterColor, AEndColor); StoreCFIndexInCells(Self, Result, ARange); end; +function TsWorksheet.WriteColorRange(ARange: TsCellRange; + AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; + AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; +begin + Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange, + AStartColor, AStartKind, AStartValue, + AEndColor, AEndKind, AEndValue); + StoreCFIndexInCells(Self, Result, ARange); +end; + function TsWorksheet.WriteColorRange(ARange: TsCellRange; AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double; ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double; diff --git a/components/fpspreadsheet/source/common/xlsxooxml.pas b/components/fpspreadsheet/source/common/xlsxooxml.pas index 219ed3cd5..c1be034b5 100644 --- a/components/fpspreadsheet/source/common/xlsxooxml.pas +++ b/components/fpspreadsheet/source/common/xlsxooxml.pas @@ -147,6 +147,8 @@ type procedure WriteConditionalFormat(AStream: TStream; AFormat: TsConditionalFormat; var APriority: Integer); procedure WriteConditionalFormatCellRule(AStream: TStream; ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer); + procedure WriteConditionalFormatColorRangeRule(AStream: TStream; ARule: TsCFColorRangeRule; + const ARange: TsCellRange; APriority: Integer); procedure WriteConditionalFormatRule(AStream: TStream; ARule: TsCFRule; const ARange: TsCellRange; var APriority: Integer); procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet); @@ -3479,98 +3481,70 @@ begin formula1Str, formula2Str ]); AppendToStream(AStream, s); -(* - case ARule.Condition of - cfcEqual..cfcLessEqual: - AppendToStream(AStream, Format( - '' + - '%s'+ - '', [ - dxfID, APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1 - ])); - - cfcBetween, cfcNotBetween: - AppendToStream(AStream, Format( - '' + - '%s'+ - '%s'+ - '', [ - dxfId, APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1, ARule.Operand2 - ])); - - cfcAboveAverage..cfcBelowEqualAverage: - begin - if (ARule.Condition in [cfcAboveAverage, cfcAboveEqualAverage]) then - aveStr := '' - else - aveStr := ' aboveAverage="0"'; - if (ARule.Condition in [cfcAboveEqualAverage, cfcBelowEqualAverage]) then - eqAveStr := ' equalAverage="1"' - else - eqAveStr := ''; - if (ARule.Operand1 = varNull) or (ARule.Operand1 = 0) then - stdDevStr := '' - else - stdDevStr := Format(' stdDev="%d"', [ARule.Operand1]); - AppendToStream(AStream, Format( - '', - [dxfId, APriority, aveStr, stdDevStr, eqAveStr])); - end; - - cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent: - begin - if ARole.Condition in [cfcBottom, cfcBottomPercent] then - bottomStr := ' bottom="1"' - else - bottomStr := ''; - if ARole.Condition in [cfcTopPercent, cfcBottomPercent] then - percentStr := ' percent="1" - else - percentStr := ''; - AppendToStream(AStream, Format( - '', - [dxfID, APriority, bottomStr, percentStr, ARole.Operand1])); - end; - - cfcBeginsWith..cfcNotContainsErrors: - begin - firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1); - if ARule.Condition = cfcNotContainsText then opStr := ' operator="notContains"' else opStr := ''; - AppendToStream(AStream, Format( - ''+ - '' + FORMULA[ARule.Condition] + '' + - '', [ - firstCellOfRange, // must be 1st ... - ARule.Operand1, // ... and 2nd parameters (see FORMULA[]) - OPERATOR_NAMES_TEXT[ARule.Condition], - dxfId, - APriority, - opStr - ])); - end; - - cfcDuplicate, cfcUnique: - begin - if ARule.Condition = cfcUnique then - typeStr := 'uniqueValues' - else - typeStr := 'duplicateValues'; - AppendToStream(AStream, Format( - '', [typeStr, dxfID, APriority])); - end; - else - FWorkbook.AddErrorMsg('ConditionalFormat operator not supported.'); - end; -*) end; +procedure TsSpreadOOXMLWriter.WriteConditionalFormatColorRangeRule(AStream: TStream; + ARule: TsCFColorRangeRule; const ARange: TsCellRange; APriority: Integer); +{ example: + + + + + + + + + + } + + function CFVO_Node(AKind: TsCFColorRangeValueKind; AValue: Double): String; + begin + Result := ''; + end; + + function Color_Node(AColor: TsColor): String; + begin + Result := Format('', [ColorToHTMLColorStr(AColor, true)]); + end; + +begin + AppendToStream(AStream, + '' + + ''); + AppendToStream(AStream, + CFVO_Node(ARule.StartValueKind, ARule.StartValue), + IfThen(ARule.ThreeColors, CFVO_Node(ARule.CenterValueKind, ARule.CenterValue), ''), + CFVO_Node(ARule.EndValueKind, ARule.EndValue) + ); + AppendToStream(AStream, + Color_Node(ARule.StartColor), + IfThen(ARule.ThreeColors, Color_Node(ARule.CenterColor), ''), + Color_Node(ARule.EndColor) + ); + AppendToStream(AStream, + '' + + ''); +end; + + procedure TsSpreadOOXMLWriter.WriteConditionalFormatRule(AStream: TStream; ARule: TsCFRule; const ARange: TsCellRange; var APriority: Integer); begin - if ARule is TsCFCellRule then begin - WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), ARange, APriority); - dec(APriority); - end; + if ARule is TsCFCellRule then + WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), ARange, APriority) + else + if ARule is TsCFColorRangeRule then + WriteConditionalFormatColorRangeRule(AStream, TsCFColorRangeRule(ARule), ARange, APriority) + else + exit; + dec(APriority); end; procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;