pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Complete writing of color range conditional formatting to ODS.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7518 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-02 09:56:11 +00:00
parent f3be18ee44
commit 006ca0de49
4 changed files with 108 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
components/fpspreadsheet/source/common/fpsconditionalformat.pas
View File

@ -36,19 +36,23 @@ type
end; end;
{ Color range } { Color range }
TsCFColorRangeValue = (crvMin, crvMax, crvPercentile); TsCFColorRangeValueKind = (crvkMin, crvkMax, crvkPercent, crkValue);
TsCFColorRangeRule = class(TsCFRule) TsCFColorRangeRule = class(TsCFRule)
StartValue: TsCFColorRangeValue; StartValueKind: TsCFColorRangeValueKind;
CenterValue: TsCFColorRangeValue; CenterValueKind: TsCFColorRangeValueKind;
EndValue: TsCFColorRangeValue; EndValueKind: TsCFColorRangeValueKind;
StartValueParam: Double; StartValue: Double;
CenterValueParam: Double; CenterValue: Double;
EndValueParam: Double; EndValue: Double;
StartColor: TsColor; StartColor: TsColor;
CenterColor: TsColor; CenterColor: TsColor;
EndColor: TsColor; EndColor: TsColor;
constructor Create;
procedure Assign(ASource: TsCFRule); override; procedure Assign(ASource: TsCFRule); override;
procedure SetupEnd(AColor: TsColor; AKind: TsCFColorRangeValueKind; AValue: Double);
procedure SetupCenter(AColor: TsColor; AKind: TsCFColorRangeValueKind; AValue: Double);
procedure SetupStart(AColor: TsColor; AKind: TsCFColorRangeValueKind; AValue: Double);
end; end;
{ DataBars } { DataBars }
@ -97,7 +101,11 @@ type
function AddCellRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; function AddCellRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
ACondition: TsCFCondition; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload; ACondition: TsCFCondition; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
AStartColor, ACenterColor, AEndColor: TsColor): Integer; AStartColor, ACenterColor, AEndColor: TsColor): 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; function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
procedure Delete(AIndex: Integer); procedure Delete(AIndex: Integer);
function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer; function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
@ -130,16 +138,27 @@ begin
raise Exception.Create('Source cannot be assigned to TCVDataBarRule'); raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
end; end;
constructor TsCFColorRangeRule.Create;
begin
inherited;
SetupStart(scRed, crvkMin, 0.0);
SetupCenter(scYellow, crvkPercent, 50.0);
SetupEnd(scBlue, crvkMax, 0.0);
EndValueKind := crvkMax;
EndValue := 0;
EndColor := scBlue;
end;
procedure TsCFColorRangeRule.Assign(ASource: TsCFRule); procedure TsCFColorRangeRule.Assign(ASource: TsCFRule);
begin begin
if ASource is TsCFColorRangeRule then if ASource is TsCFColorRangeRule then
begin begin
StartValueKind := TsCFColorRangeRule(ASource).StartValueKind;
CenterValueKind := TsCFColorRangeRule(ASource).CenterValueKind;
EndValueKind := TsCFColorRangeRule(ASource).EndValueKind;
StartValue := TsCFColorRangeRule(ASource).StartValue; StartValue := TsCFColorRangeRule(ASource).StartValue;
CenterValue := TsCFColorRangeRule(ASource).CenterValue; CenterValue := TsCFColorRangeRule(ASource).CenterValue;
EndValue := TsCFColorRangeRule(ASource).EndValue; EndValue := TsCFColorRangeRule(ASource).EndValue;
StartValueParam := TsCFColorRangeRule(ASource).StartValueParam;
CenterValueParam := TsCFColorRangeRule(ASource).CenterValueParam;
EndValueParam := TsCFColorRangeRule(ASource).EndValueParam;
StartColor := TsCFColorRangeRule(ASource).StartColor; StartColor := TsCFColorRangeRule(ASource).StartColor;
CenterColor := TsCFColorRangeRule(ASource).CenterColor; CenterColor := TsCFColorRangeRule(ASource).CenterColor;
EndColor := TsCFColorRangeRule(ASource).EndColor; EndColor := TsCFColorRangeRule(ASource).EndColor;
@ -147,6 +166,31 @@ begin
raise Exception.Create('Source cannot be assigned to TCVDataBarRule'); raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
end; end;
procedure TsCFColorRangeRule.SetupCenter(AColor: TsColor;
AKind: TsCFColorrangeValueKind; AValue: Double);
begin
CenterValueKind := AKind;
CenterValue := AValue;
CenterColor := AColor;
end;
procedure TsCFColorRangeRule.SetupEnd(AColor: TsColor;
AKind: TsCFColorRangeValueKind; AValue: Double);
begin
EndValueKind := AKind;
EndValue := AValue;
EndColor := AColor;
end;
procedure TsCFColorRangeRule.SetupStart(AColor: TsColor;
AKind: TsCFColorrangeValueKind; AValue: Double);
begin
StartValueKind := AKind;
StartValue := AValue;
StartColor := AColor;
end;
{ TCFRule } { TCFRule }
@ -278,6 +322,21 @@ begin
Result := AddRule(ASheet, ARange, rule); Result := AddRule(ASheet, ARange, rule);
end; end;
function TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer;
var
rule: TsCFColorRangeRule;
begin
rule := TsCFColorRangeRule.Create;
rule.SetupStart(AStartColor, AStartKind, AStartValue);
rule.SetupCenter(ACenterColor, ACenterKind, ACenterValue);
rule.SetupEnd(AEndColor, AEndKind, AEndValue);
Result := AddRule(ASheet, ARange, rule);
end;
function TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet; function TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange): Integer; ARange: TsCellRange): Integer;
var var

24
components/fpspreadsheet/source/common/fpsopendocument.pas
View File

@ -410,6 +410,12 @@ const
'is-error', 'is-no-error' // cfcContainsErrors, cfcNotContainsErrors 'is-error', 'is-no-error' // cfcContainsErrors, cfcNotContainsErrors
); );
CF_COLORRANGE_VALUE_KIND: array[TsCFColorRangeValueKind] of string = (
'minimum', // crvkMin
'maximum', // crvkMax
'percentile', // crvkPercent
'number' //crkValue
);
function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String; function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String;
var var
@ -5957,13 +5963,19 @@ begin
cf_ColorRangeRule := TsCFColorRangeRule(cf.Rules[j]); cf_ColorRangeRule := TsCFColorRangeRule(cf.Rules[j]);
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<calcext:color-scale>' + '<calcext:color-scale>' +
'<calcext:color-scale-entry calcext:value="0" calcext:type="minimum" calcext:color="%s" />' + '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
'<calcext:color-scale-entry calcext:value="50" calcext:type="percentile" calcext:color="%s" />' + '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
'<calcext:color-scale-entry calcext:value="0" calcext:type="maximum" calcext:color="%s" />' + '<calcext:color-scale-entry calcext:value="%g" calcext:type="%s" calcext:color="%s" />' +
'</calcext:color-scale>', [ '</calcext:color-scale>', [
ColorToHTMLColorStr(cf_ColorRangeRule.StartColor), cf_ColorRangeRule.StartValue,
ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor), CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.StartValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.EndColor) 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)
])); ]));
end; end;
end; end;

7
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -392,7 +392,12 @@ type
function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition; function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
// color range // color range
function WriteColorRange(ARange: TsCellRange; AStartColor, ACenterColor, AEndColor: TsColor): Integer; function WriteColorRange(ARange: TsCellRange; AStartColor: TsColor = scRed;
ACenterColor: TsColor = scYellow; AEndColor: TsColor = scBlue): Integer; overload;
function WriteColorRange(ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer; overload;
// data bars // data bars
function WriteDataBars(ARange: TsCellRange): Integer; function WriteDataBars(ARange: TsCellRange): Integer;

15
components/fpspreadsheet/source/common/fpspreadsheet_cf.inc
View File

@ -69,13 +69,26 @@ end;
Writes the conditional format "color range" Writes the conditional format "color range"
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsWorksheet.WriteColorRange(ARange: TsCellRange; function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor, ACenterColor, AEndColor: TsColor): Integer; AStartColor: TsColor = scRed; ACenterColor: TsColor = scYellow;
AEndColor: TsColor = scBlue): Integer;
begin begin
Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange, Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange,
AStartColor, ACenterColor, AEndColor); AStartColor, ACenterColor, AEndColor);
StoreCFIndexInCells(Self, Result, ARange); StoreCFIndexInCells(Self, Result, ARange);
end; end;
function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFColorRangeValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange,
AStartColor, AStartKind, AStartValue,
ACenterColor, ACenterKind, ACenterValue,
AEndColor, AEndKind, AEndValue);
StoreCFIndexInCells(Self, Result, ARange);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Writes the conditional format "data bars" Writes the conditional format "data bars"
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}