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

fpspreadsheet: Add writing of databar conditional formatting to XLSX and fix it for ODS.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7521 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-02 13:35:01 +00:00
parent f3437814bf
commit 9bfeddaaf5
6 changed files with 170 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/other/conditional_formatting/demo_conditional_formatting.pas
View File

@ -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), scRed);
// ColorRange
inc(row);

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

@ -35,13 +35,13 @@ type
procedure Assign(ASource: TsCFRule); override;
end;
{ Color range }
TsCFColorRangeValueKind = (crvkMin, crvkMax, crvkPercent, crvkValue);
TsCFValueKind = (vkMin, vkMax, vkPercent, vkPercentile, vkValue);
{ Color range }
TsCFColorRangeRule = class(TsCFRule)
StartValueKind: TsCFColorRangeValueKind;
CenterValueKind: TsCFColorRangeValueKind;
EndValueKind: TsCFColorRangeValueKind;
StartValueKind: TsCFValueKind;
CenterValueKind: TsCFValueKind;
EndValueKind: TsCFValueKind;
StartValue: Double;
CenterValue: Double;
EndValue: Double;
@ -51,13 +51,19 @@ type
ThreeColors: Boolean;
constructor Create;
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);
procedure SetupEnd(AColor: TsColor; AKind: TsCFValueKind; AValue: Double);
procedure SetupCenter(AColor: TsColor; AKind: TsCFValueKind; AValue: Double);
procedure SetupStart(AColor: TsColor; AKind: TsCFValueKind; AValue: Double);
end;
{ DataBars }
TsCFDatabarRule = class(TsCFRule)
StartValueKind: TsCFValueKind;
EndValueKind: TsCFValueKind;
StartValue: Double;
EndValue: Double;
BarColor: TsColor;
constructor Create;
procedure Assign(ASource: TsCFRule); override;
end;
@ -107,14 +113,18 @@ type
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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; 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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
ABarColor: TsColor): Integer; overload;
function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
ABarColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
procedure Delete(AIndex: Integer);
function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
@ -138,6 +148,14 @@ begin
raise Exception.Create('Source cannot be assigned to TCVCellRule');
end;
constructor TsCFDataBarRule.Create;
begin
inherited;
StartValueKind := vkMin;
EndValueKind := vkMax;
BarColor := scBlue;
end;
procedure TsCFDataBarRule.Assign(ASource: TsCFRule);
begin
if ASource is TsCFDataBarRule then
@ -151,10 +169,10 @@ constructor TsCFColorRangeRule.Create;
begin
inherited;
ThreeColors := true;
SetupStart(scRed, crvkMin, 0.0);
SetupCenter(scYellow, crvkPercent, 50.0);
SetupEnd(scBlue, crvkMax, 0.0);
EndValueKind := crvkMax;
SetupStart(scRed, vkMin, 0.0);
SetupCenter(scYellow, vkPercent, 50.0);
SetupEnd(scBlue, vkMax, 0.0);
EndValueKind := vkMax;
EndValue := 0;
EndColor := scBlue;
end;
@ -178,7 +196,7 @@ begin
end;
procedure TsCFColorRangeRule.SetupCenter(AColor: TsColor;
AKind: TsCFColorrangeValueKind; AValue: Double);
AKind: TsCFValueKind; AValue: Double);
begin
CenterValueKind := AKind;
CenterValue := AValue;
@ -186,7 +204,7 @@ begin
end;
procedure TsCFColorRangeRule.SetupEnd(AColor: TsColor;
AKind: TsCFColorRangeValueKind; AValue: Double);
AKind: TsCFValueKind; AValue: Double);
begin
EndValueKind := AKind;
EndValue := AValue;
@ -194,7 +212,7 @@ begin
end;
procedure TsCFColorRangeRule.SetupStart(AColor: TsColor;
AKind: TsCFColorrangeValueKind; AValue: Double);
AKind: TsCFValueKind; AValue: Double);
begin
StartValueKind := AKind;
StartValue := AValue;
@ -348,8 +366,8 @@ end;
function TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
var
rule: TsCFColorRangeRule;
begin
@ -362,9 +380,9 @@ 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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
var
rule: TsCFColorRangeRule;
begin
@ -377,11 +395,27 @@ begin
end;
function TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange): Integer;
ARange: TsCellRange; ABarColor: TsColor): Integer;
var
rule: TsCFRule;
rule: TsCFDataBarRule;
begin
rule := TsCFDataBarRule.Create;
rule.BarColor:= ABarColor;
Result := AddRule(ASheet, ARange, rule);
end;
function TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; ABarColor: TsColor; AStartKind: TsCFValuekind;
AStartValue: Double; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
var
rule: TsCFDataBarRule;
begin
rule := TsCFDataBarRule.Create;
rule.BarColor:= ABarColor;
rule.StartValueKind := AStartKind;
rule.StartValue := AStartValue;
rule.EndValueKind := AEndKind;
rule.EndValue := AEndValue;
Result := AddRule(ASheet, ARange, rule);
end;

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

@ -410,11 +410,12 @@ const
'is-error', 'is-no-error' // cfcContainsErrors, cfcNotContainsErrors
);
CF_COLORRANGE_VALUE_KIND: array[TsCFColorRangeValueKind] of string = (
'minimum', // crvkMin
'maximum', // crvkMax
'percentile', // crvkPercent
'number' //crkValue
CF_VALUE_KIND: array[TsCFValueKind] of string = (
'minimum', // vkMin
'maximum', // vkMax
'percent', // vkPercent
'percentile', // vkPercentile
'number' // vkValue
);
function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String;
@ -5947,14 +5948,17 @@ begin
if cf.Rules[j] is TsCFDatabarRule then
begin
cf_DatabarRule := TsCFDatabarRule(cf.Rules[j]);
AppendToStream(AStream,
'<calcext:data-bar calcext:min-length="10" calcext:max-length="90" ' +
'calcext:negative-color="#ff0000"> calcext:positive-color="%ff0000" ' +
AppendToStream(AStream, Format(
'<calcext:data-bar calcext:max-length="100" ' +
'calcext:negative-color="%s" calcext:positive-color="%s" ' +
'calcext:axis-color="#000000">' +
'<calext:formatting-entry calcext:value="0" calcext:type="auto-minimum" />' +
'calcext:formatting-entry calcext:value="0" calcext:type="auto-maximum" />' +
'</calcext:data-bar>'
);
'<calcext:formatting-entry calcext:value="%g" calcext:type="%s" />' +
'<calcext:formatting-entry calcext:value="%g" calcext:type="%s" />' +
'</calcext:data-bar>', [
ColorToHTMLColorStr(cf_DatabarRule.BarColor), ColorToHTMLColorStr(cf_DatabarRule.BarColor),
cf_DatabarRule.StartValue, CF_VALUE_KIND[cf_DatabarRule.StartValueKind],
cf_DatabarRule.EndValue, CF_VALUE_KIND[cf_DatabarRule.EndValueKind]
]));
// This is the default node after import from xlsx
end
else
@ -5969,13 +5973,13 @@ begin
'<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],
CF_VALUE_KIND[cf_ColorRangeRule.StartValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.StartColor),
cf_ColorRangeRule.CenterValue,
CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.CenterValueKind],
CF_VALUE_KIND[cf_ColorRangeRule.CenterValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor),
cf_ColorRangeRule.EndValue,
CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
CF_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
]))
else
@ -5985,10 +5989,10 @@ begin
'<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],
CF_VALUE_KIND[cf_ColorRangeRule.StartValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.StartColor),
cf_ColorRangeRule.EndValue,
CF_COLORRANGE_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
CF_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
]));
end;

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

@ -397,14 +397,17 @@ type
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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): 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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
// data bars
function WriteDataBars(ARange: TsCellRange): Integer;
function WriteDataBars(ARange: TsCellRange; ABarColor: TsColor): Integer; overload;
function WriteDataBars(ARange: TsCellRange; ABarColor: TsColor;
AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
{ Formulas }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;

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

@ -85,8 +85,8 @@ begin
end;
function TsWorksheet.WriteColorRange(ARange: TsCellRange;
AStartColor: TsColor; AStartKind: TsCFColorRangeValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFColorRangeValueKind; AEndValue: Double): Integer;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange,
AStartColor, AStartKind, AStartValue,
@ -95,9 +95,9 @@ begin
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;
AStartColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
ACenterColor: TsColor; ACenterKind: TsCFValueKind; ACenterValue: Double;
AEndColor: TsColor; AEndKind: TsCFValueKind; AEndValue: Double): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddColorRangeRule(Self, ARange,
AStartColor, AStartKind, AStartValue,
@ -109,9 +109,21 @@ end;
{@@ ----------------------------------------------------------------------------
Writes the conditional format "data bars"
-------------------------------------------------------------------------------}
function TsWorksheet.WriteDataBars(ARange: TscellRange): Integer;
function TsWorksheet.WriteDataBars(ARange: TscellRange; ABarColor: TsColor): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddDataBarRule(Self, ARange);
Result := FWorkbook.FConditionalFormatList.AddDataBarRule(Self, ARange, ABarColor);
StoreCFIndexInCells(self, Result, ARange);
end;
function TsWorksheet.WriteDataBars(ARange: TscellRange; ABarColor: TsColor;
AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddDataBarRule(Self, ARange,
ABarColor,
AStartKind, AStartValue,
AEndKind, AEndValue
);
StoreCFIndexInCells(self, Result, ARange);
end;

82
components/fpspreadsheet/source/common/xlsxooxml.pas
View File

@ -149,6 +149,8 @@ type
ARange: TsCellRange; APriority: Integer);
procedure WriteConditionalFormatColorRangeRule(AStream: TStream; ARule: TsCFColorRangeRule;
const ARange: TsCellRange; APriority: Integer);
procedure WriteConditionalFormatDataBarRule(AStream: TStream; ARule: TsCFDatabarRule;
const ARange: TsCellRange; APriority: Integer);
procedure WriteConditionalFormatRule(AStream: TStream; ARule: TsCFRule;
const ARange: TsCellRange; var APriority: Integer);
procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet);
@ -432,6 +434,24 @@ begin
Result := (s = '0') or (Lowercase(s) = 'false');
end;
function CF_ValueNode(AKind: TsCFValueKind; AValue: Double): String;
begin
Result := '<cfvo';
case AKind of
vkMin : Result := Result + ' type="min"';
vkMax : Result := Result + ' type="max"';
vkPercent : Result := Result + Format(' type="percent" val="%g"', [AValue]);
vkPercentile : Result := Result + Format(' type="percentile" val="%g"', [AValue]);
vkValue : Result := Result + Format(' type="num" val="%g"', [AValue]);
end;
Result := Result + ' />';
end;
function CF_ColorNode(AColor: TsColor): String;
begin
Result := Format('<color rgb="%s" />', [ColorToHTMLColorStr(AColor, true)]);
end;
{------------------------------------------------------------------------------}
{ TsSpreadOOXMLReader }
@ -3496,43 +3516,54 @@ procedure TsSpreadOOXMLWriter.WriteConditionalFormatColorRangeRule(AStream: TStr
<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)
CF_ValueNode(ARule.StartValueKind, ARule.StartValue),
IfThen(ARule.ThreeColors, CF_ValueNode(ARule.CenterValueKind, ARule.CenterValue), ''),
CF_ValueNode(ARule.EndValueKind, ARule.EndValue)
);
AppendToStream(AStream,
Color_Node(ARule.StartColor),
IfThen(ARule.ThreeColors, Color_Node(ARule.CenterColor), ''),
Color_Node(ARule.EndColor)
CF_ColorNode(ARule.StartColor),
IfThen(ARule.ThreeColors, CF_ColorNode(ARule.CenterColor), ''),
CF_ColorNode(ARule.EndColor)
);
AppendToStream(AStream,
'</colorScale>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormatDatabarRule(AStream: TStream;
ARule: TsCFDataBarRule; const ARange: TsCellRange; APriority: Integer);
{ example from test file:
<cfRule type="dataBar" priority="1">
<dataBar>
<cfvo type="min" />
<cfvo type="max" />
<color rgb="FF638EC6" />
</dataBar>
<extLst>
<ext uri="{B025F937-C7B1-47D3-B67F-A62EFF666E3E}" xmlns:x14="http://schemas.microsoft.com/office/spreadsheetml/2009/9/main">
<x14:id>{A620EE03-2FEC-4D54-872C-66BDB99CB07E}</x14:id>
</ext>
</extLst>
</cfRule> }
begin
AppendToStream(AStream,
'<cfRule type="dataBar" priority="' + IntToStr(APriority) + '">' +
'<dataBar>');
AppendToStream(AStream,
CF_ValueNode(ARule.StartValueKind, ARule.StartValue),
CF_ValueNode(ARule.EndValueKind, ARule.EndValue),
CF_ColorNode(ARule.BarColor) );
AppendToStream(AStream,
'</dataBar>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormatRule(AStream: TStream;
ARule: TsCFRule; const ARange: TsCellRange; var APriority: Integer);
@ -3542,6 +3573,9 @@ begin
else
if ARule is TsCFColorRangeRule then
WriteConditionalFormatColorRangeRule(AStream, TsCFColorRangeRule(ARule), ARange, APriority)
else
if ARule is TsCFDataBarRule then
WriteConditionalFormatDataBarRule(AStream, TsCFDataBarRule(ARule), ARange, APriority)
else
exit;
dec(APriority);