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
2020-07-02 10:53:42 +00:00
parent 3aae7af514
commit f3437814bf
6 changed files with 164 additions and 109 deletions
--- 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);
--- 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;

--- a/components/fpspreadsheet/source/common/fpsopendocument.pas
+++ b/components/fpspreadsheet/source/common/fpsopendocument.pas
@@ -5961,6 +5961,7 @@ begin
      if cf.Rules[j] is TsCFColorRangeRule then
      begin
        cf_ColorRangeRule := TsCFColorRangeRule(cf.Rules[j]);
+        if cf_ColorRangeRule.ThreeColors then
          AppendToStream(AStream, Format(
            '<calcext:color-scale>' +
              '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
@@ -5976,6 +5977,19 @@ begin
            cf_ColorRangeRule.EndValue,
              CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
              ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
+          ]))
+        else
+          AppendToStream(AStream, Format(
+            '<calcext:color-scale>' +
+              '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
+              '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
+            '</calcext:color-scale>', [
+            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;
--- 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;
--- 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;
--- 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(
-        '<cfRule type="cellIs" dxfId="%d" priority="%d" operator="%s">' +
-          '<formula>%s</formula>'+
-        '</cfRule>', [
-        dxfID, APriority, OPERATOR_NAMES_1[ARule.Condition], ARule.Operand1
-      ]));
-
-    cfcBetween, cfcNotBetween:
-      AppendToStream(AStream, Format(
-        '<cfRule type="cellIs" dxfId="%d" priority="%d" operator="%s">' +
-          '<formula>%s</formula>'+
-          '<formula>%s</formula>'+
-        '</cfRule>', [
-        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(
-          '<cfRule type="aboveAverage" dxfId="%d" priority="%d"%s%s%s />',
-            [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(
-          '<cfRule type="top10" dxfId="%d" priority="%d"%s%s rank="%d" />',
-          [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(
-          '<cfRule type="%2:s" dxfId="%3:d" priority="%4:d"%5:s text="%1:s">'+
-            '<formula>' + FORMULA[ARule.Condition] + '</formula>' +
-          '</cfRule>', [
-          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(
-          '<cfRule type="%s" dxfId="%d" priority="%d" />', [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:
+    <cfRule type="colorScale" priority="3">
+      <colorScale>
+        <cfvo type="min" />
+        <cfvo type="percentile" val="50" />
+        <cfvo type="max" />
+        <color rgb="FFF8696B" />
+        <color rgb="FFFFEB84" />
+        <color rgb="FF63BE7B" />
+      </colorScale>
+    </cfRule> }
+
+  function CFVO_Node(AKind: TsCFColorRangeValueKind; AValue: Double): String;
+  begin
+    Result := '<cfvo';
+    case AKind of
+      crvkMin    : Result := Result + ' type="min"';
+      crvkMax    : Result := Result + ' type="max"';
+      crvkPercent: Result := Result + Format(' type="percentile" val="%g"', [AValue]);
+      crvkValue  : Result := Result + Format(' type="num" val="%g"', [AValue]);
+    end;
+    Result := Result + ' />';
+  end;
+
+  function Color_Node(AColor: TsColor): String;
+  begin
+    Result := Format('<color rgb="%s" />', [ColorToHTMLColorStr(AColor, true)]);
+  end;
+
+begin
+  AppendToStream(AStream,
+    '<cfRule type="colorScale" priority="' + IntToStr(APriority) + '">' +
+      '<colorScale>');
+  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,
+      '</colorScale>' +
+    '</cfRule>');
+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);
+  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;
 end;

 procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;