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

fpspreadsheet: Elemental DataBars and ColorRange formatting for ODS writer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7516 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-01 22:15:30 +00:00
parent 28e834c330
commit 68f2d8718d
5 changed files with 85 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -286,6 +286,17 @@ begin
fmt.SetVertAlignment(vaTop);
sh.WriteConditionalCellFormat(Range(row, 2, row, lastCol), cfcEqual, 'abc', wb.AddCellFormat(fmt));
// Databar
inc(row);
sh.WriteText(row, 0, 'Data bar');
sh.WriteDatabars(Range(Row, 2, row, 12));
// ColorRange
inc(row);
sh.WriteText(row, 0, 'Color Range');
sh.WriteText(row, 1, 'yellow -> blue -> red');
sh.WriteColorRange(Range(Row, 2, row, 12), scYellow, scBlue, scRed);
{ ------ Save workbook to file-------------------------------------------- }
wb.WriteToFile('test.xlsx', true);
wb.WriteToFile('test.ods', true);

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

@ -96,8 +96,9 @@ type
ACondition: TsCFCondition; AParam: Variant; ACellFormatIndex: Integer): Integer; overload;
function AddCellRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
ACondition: TsCFCondition; AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
procedure AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange);
function AddColorRangeRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
AStartColor, ACenterColor, AEndColor: TsColor): Integer;
function AddDataBarRule(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
procedure Delete(AIndex: Integer);
function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
end;
@ -265,16 +266,25 @@ begin
Result := AddRule(ASheet, ARange, rule);
end;
procedure TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange);
function TsConditionalFormatList.AddColorRangeRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; AStartColor, ACenterColor, AEndColor: TsColor): Integer;
var
rule: TsCFColorRangeRule;
begin
raise EXception.Create('ColorRange not yet implemented.');
rule := TsCFColorRangeRule.Create;
rule.StartColor := AStartColor;
rule.CenterColor := ACenterColor;
rule.EndColor := AEndColor;
Result := AddRule(ASheet, ARange, rule);
end;
procedure TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange);
function TsConditionalFormatlist.AddDataBarRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange): Integer;
var
rule: TsCFRule;
begin
raise Exception.Create('DataBars not yet implemented.');
rule := TsCFDataBarRule.Create;
Result := AddRule(ASheet, ARange, rule);
end;

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

@ -5891,6 +5891,8 @@ var
cf_range: TsCellRange;
cf_styleName: String;
cf_cellRule: TsCFCellRule;
cf_DataBarRule: TsCFDataBarRule;
cf_ColorRangeRule: TsCFColorRangeRule;
i,j: Integer;
sheet: TsWorksheet;
rangeStr: String;
@ -5934,6 +5936,35 @@ begin
[cf_stylename, opStr, firstCellStr]
));
end;
end
else
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" ' +
'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>'
);
// This is the default node after import from xlsx
end
else
if cf.Rules[j] is TsCFColorRangeRule then
begin
cf_ColorRangeRule := TsCFColorRangeRule(cf.Rules[j]);
AppendToStream(AStream, Format(
'<calcext:color-scale>' +
'<calcext:color-scale-entry calcext:value="0" calcext:type="minimum" calcext:color="%s" />' +
'<calcext:color-scale-entry calcext:value="50" calcext:type="percentile" calcext:color="%s" />' +
'<calcext:color-scale-entry calcext:value="0" calcext:type="maximum" calcext:color="%s" />' +
'</calcext:color-scale>', [
ColorToHTMLColorStr(cf_ColorRangeRule.StartColor),
ColorToHTMLColorStr(cf_ColorRangeRule.CenterColor),
ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
]));
end;
end;

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

@ -384,12 +384,17 @@ type
AValue: TsCellProtections); overload;
{ Conditional formatting }
// cell-related comparisons
function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
ACellFormatIndex: Integer): Integer; overload;
function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
AParam: Variant; ACellFormatIndex: Integer): Integer; overload;
function WriteConditionalCellFormat(ARange: TsCellRange; ACondition: TsCFCondition;
AParam1, AParam2: Variant; ACellFormatIndex: Integer): Integer; overload;
// color range
function WriteColorRange(ARange: TsCellRange; AStartColor, ACenterColor, AEndColor: TsColor): Integer;
// data bars
function WriteDataBars(ARange: TsCellRange): Integer;
{ Formulas }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;

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

@ -65,3 +65,23 @@ begin
StoreCFIndexInCells(self, Result, ARange);
end;
{@@ ----------------------------------------------------------------------------
Writes the conditional format "color range"
-------------------------------------------------------------------------------}
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;
{@@ ----------------------------------------------------------------------------
Writes the conditional format "data bars"
-------------------------------------------------------------------------------}
function TsWorksheet.WriteDataBars(ARange: TscellRange): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddDataBarRule(Self, ARange);
StoreCFIndexInCells(self, Result, ARange);
end;