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

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

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;
 

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(
+        if cf_ColorRangeRule.ThreeColors then
-          '<calcext:color-scale>' +
+          AppendToStream(AStream, Format(
-            '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
+            '<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-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>', [
+              '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
-          cf_ColorRangeRule.StartValue,
+            '</calcext:color-scale>', [
-            CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind],
+            cf_ColorRangeRule.StartValue,
-            ColorToHTMLColorStr(cf_ColorRangeRule.StartColor),
+              CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind],
-          cf_ColorRangeRule.CenterValue,
+              ColorToHTMLColorStr(cf_ColorRangeRule.StartColor),
-            CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.CenterValueKind],
+            cf_ColorRangeRule.CenterValue,
-            ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor),
+              CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.CenterValueKind],
-          cf_ColorRangeRule.EndValue,
+              ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor),
-            CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
+            cf_ColorRangeRule.EndValue,
-            ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
+              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;
 

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;
+    function WriteColorRange(ARange: TsCellRange;
-      ACenterColor: TsColor = scYellow; AEndColor: TsColor = scBlue): Integer; overload;
+      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;

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;
+  AStartColor, AEndColor: TsColor): Integer;
-  AEndColor: TsColor = scBlue): 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;

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
+  if ARule is TsCFCellRule then
-    WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), ARange, APriority);
+    WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), ARange, APriority)
-    dec(APriority);
+  else
-  end;
+  if ARule is TsCFColorRangeRule then
+    WriteConditionalFormatColorRangeRule(AStream, TsCFColorRangeRule(ARule), ARange, APriority)
+  else
+    exit;
+  dec(APriority);
 end;
 
 procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;