fpspreadsheet: Support conditional icon set format in worksheet, and in XLSX and ODS file access. Add unit tests for it.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7558 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-23 22:25:24 +00:00
parent 481e50d840
commit e191dd00e5
8 changed files with 954 additions and 200 deletions

View File

@@ -26,7 +26,7 @@ begin
sh.WriteText(0, 2, 'Test values'); sh.WriteText(0, 2, 'Test values');
row := 2; row := 2;
for i := row to row+30 do for i := row to row+33 do
begin begin
sh.WriteNumber(i, 2, 1.0); sh.WriteNumber(i, 2, 1.0);
sh.WriteNumber(i, 3, 2.0); sh.WriteNumber(i, 3, 2.0);
@@ -324,6 +324,12 @@ begin
sh.WriteText(row, 1, 'yellow -> red'); sh.WriteText(row, 1, 'yellow -> red');
sh.WriteColorRange(Range(Row, 2, row, 12), scYellow, scRed); sh.WriteColorRange(Range(Row, 2, row, 12), scYellow, scRed);
// Icon sets
inc(row);
sh.WriteText(row, 0, 'IconSet');
sh.WriteText(row, 1, '3 flags');
sh.WriteIconSet(Range(Row, 2, row, 12), is3Flags);
{ ------ Save workbook to file-------------------------------------------- } { ------ Save workbook to file-------------------------------------------- }
wb.WriteToFile('test.xlsx', true); wb.WriteToFile('test.xlsx', true);
wb.WriteToFile('test.ods', true); wb.WriteToFile('test.ods', true);

View File

@@ -68,6 +68,41 @@ type
procedure Assign(ASource: TsCFRule); override; procedure Assign(ASource: TsCFRule); override;
end; end;
{ Icon sets }
TsCFIconSet = (
is3Arrows, is3ArrowsGray, is3Flags,
is3TrafficLights1, // x14 in xlsx
is3TrafficLights2, is3Signs, is3Symbols, is3Symbols2,
is3Smilies, is3Stars, is3Triangles, is3ColorSmilies, // need x14 in xlsx
is4Arrows, is4ArrowsGray, is4RedToBlack, is4Rating,
is4TrafficLights, // not in ODS
is5Arrows, is5ArrowsGray, is5Rating, is5Quarters,
is5Boxes // needs x14 in Excel
);
TsCFIconSetRule = class(TsCFRule)
private
FIconSet: TsCFIconSet;
FReverse: Boolean;
FShowValue: Boolean;
FValueKinds: array of TsCFValuekind;
FValues: array of double;
function GetIconCount: Integer;
function GetValueKinds(AIndex: Integer): TsCFValueKind;
function GetValues(AIndex: Integer): Double;
procedure SetIconSet(AValue: TsCFIconSet);
procedure SetValueKinds(AIndex: Integer; AKind: TsCFValueKind);
procedure SetValues(AIndex: Integer; AValue: Double);
public
constructor Create;
procedure Assign(ASource: TsCFRule); override;
property IconSet: TsCFIconSet read FIconSet write SetIconSet;
property IconCount: Integer read GetIconCount;
property Values[AIndex: Integer]: Double read GetValues write SetValues;
property ValueKinds[AIndex: Integer]: TsCFValueKind read GetValueKinds write SetValueKinds;
property Reverse: Boolean read FReverse write FReverse;
property ShowValue: Boolean read FShowValue write FShowValue;
end;
{ Rules } { Rules }
TsCFRules = class(TFPObjectList) TsCFRules = class(TFPObjectList)
private private
@@ -127,17 +162,44 @@ type
ABarColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double; ABarColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload; AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
function AddIconSetRule(ASheet: TsBasicWorksheet; ARange: TsCellRange;
AIconSet: TsCFIconSet; AHideValue: Boolean = false; AReverse: Boolean = false): Integer; overload;
function AddIconSetRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer; overload;
function AddIconSetRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer; overload;
function AddIconSetRule(ASheet: TsBasicWorksheet; ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AValueKind4: TsCFValueKind; AValue4: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer; overload;
procedure Delete(AIndex: Integer); procedure Delete(AIndex: Integer);
function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer; function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
end; end;
function GetCFIconCount(AIconSet: TsCFIconSet): Integer;
implementation implementation
uses uses
Math, Math, TypInfo,
fpSpreadsheet; fpSpreadsheet;
function GetCFIconCount(AIconSet: TsCFIconSet): Integer;
var
s: String;
begin
s := GetEnumName(TypeInfo(TsCFIconSet), integer(AIconSet));
Result := ord(s[3]) - ord('0');
end;
procedure TsCFCellRule.Assign(ASource: TsCFRule); procedure TsCFCellRule.Assign(ASource: TsCFRule);
begin begin
if ASource is TsCFCellRule then if ASource is TsCFCellRule then
@@ -164,7 +226,7 @@ begin
begin begin
// //
end else end else
raise Exception.Create('Source cannot be assigned to TCVDataBarRule'); raise Exception.Create('Source cannot be assigned to TsCFDataBarRule');
end; end;
constructor TsCFColorRangeRule.Create; constructor TsCFColorRangeRule.Create;
@@ -194,7 +256,7 @@ begin
CenterColor := TsCFColorRangeRule(ASource).CenterColor; CenterColor := TsCFColorRangeRule(ASource).CenterColor;
EndColor := TsCFColorRangeRule(ASource).EndColor; EndColor := TsCFColorRangeRule(ASource).EndColor;
end else end else
raise Exception.Create('Source cannot be assigned to TCVDataBarRule'); raise Exception.Create('Source cannot be assigned to TsCFColorRangeRule');
end; end;
procedure TsCFColorRangeRule.SetupCenter(AColor: TsColor; procedure TsCFColorRangeRule.SetupCenter(AColor: TsColor;
@@ -222,8 +284,89 @@ begin
end; end;
{ TsCFIconSetRule }
{ TCFRule } constructor TsCFIconSetRule.Create;
begin
FIconSet := is3Arrows;
SetLength(FValues, 2);
Setlength(FValueKinds, 2);
FValues[0] := 33;
FValues[1] := 66;
FValueKinds[0] := vkPercent;
FValueKinds[1] := vkPercent;
FShowValue := true;
FReverse := false;
end;
procedure TsCFIconSetRule.Assign(ASource: TsCFRule);
var
i: Integer;
begin
if ASource is TsCFIconSetRule then
begin
SetIconSet(TsCFIconSetRule(ASource).IconSet);
for i := 0 to High(FValues) do
FValues[i] := TsCFIconSetRule(ASource).Values[i];
for i := 0 to High(FValueKinds) do
FValueKinds[i] := TsCFIconSetRule(ASource).ValueKinds[i];
FShowValue := TsCFIconSetRule(ASource).ShowValue;
FReverse := TsCFIconSetRule(ASource).Reverse;
end else
raise Exception.Create('Source cannot be assigned to TsCFIconSetRule');
end;
function TsCFIconSetRule.GetIconCount: Integer;
begin
Result := Length(FValues) + 1;
end;
function TsCFIconSetRule.GetValueKinds(AIndex: Integer): TsCFValueKind;
begin
Result := FValueKinds[AIndex];
end;
function TsCFIconSetRule.GetValues(AIndex: Integer): Double;
begin
Result := FValues[AIndex];
end;
procedure TsCFIconSetRule.SetIconSet(AValue: TsCFIconSet);
var
s: String;
i, n: Integer;
begin
if AValue = FIconSet then exit;
FIconSet := AValue;
s := GetEnumName(TypeInfo(TsCFIconSet), integer(AValue));
n := Ord(s[3]) - ord('0');
SetLength(FValues, n - 1);
for i := 0 to High(FValues) do
FValues[i] := (i + 1) * 100 div n;
SetLength(FValueKinds, n - 1);
for i := 0 to High(FValueKinds) do
FValueKinds[i] := vkPercent;
// value index
// (min) 0 1 2 (max)
// |---------|---------|---------|----------|
// icon0 icon1 icon2 icon3
end;
procedure TsCFIconSetRule.SetValueKinds(AIndex: Integer; AKind: TsCFValueKind);
begin
FValueKinds[AIndex] := AKind;
end;
procedure TsCFIconSetRule.SetValues(AIndex: Integer; AValue: Double);
begin
FValues[AIndex] := AValue;
end;
{ TsCFRule }
function TsCFRules.GetItem(AIndex: Integer): TsCFRule; function TsCFRules.GetItem(AIndex: Integer): TsCFRule;
begin begin
@@ -424,6 +567,115 @@ begin
end; end;
function TsConditionalFormatList.AddIconSetRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; AIconSet: TsCFIconSet; AHideValue: Boolean = false;
AReverse: Boolean = false): Integer;
var
rule: TsCFIconSetRule;
i, n: Integer;
begin
rule := TsCFIconSetRule.Create;
rule.IconSet := AIconset;
n := rule.IconCount;
for i := 0 to n - 2 do
begin
rule.ValueKinds[i] := vkPercent;
rule.Values[i] := ((i+1) * 100) div n
end;
rule.ShowValue := not AHideValue;
rule.Reverse := AReverse;
Result := AddRule(ASheet, ARange, rule);
end;
{ IconSet conditional format for 3 icons, ie. 2 values }
function TsConditionalFormatList.AddIconSetRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer;
var
rule: TsCFIconSetRule;
n: Integer;
begin
rule := TsCFIconSetRule.Create;
rule.IconSet := AIconset;
n := rule.IconCount;
if n <> 3 then begin
rule.Free;
Result := -1;
exit;
end;
rule.ValueKinds[0] := AValueKind1; rule.Values[0] := AValue1;
rule.ValueKinds[1] := AValueKind2; rule.Values[1] := AValue2;
rule.ShowValue := not AHideValue;
rule.Reverse := AReverse;
Result := AddRule(ASheet, ARange, rule);
end;
{ IconSet conditional format for 4 icons, i.e. 3 values }
function TsConditionalFormatList.AddIconSetRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer;
var
rule: TsCFIconSetRule;
n: Integer;
begin
rule := TsCFIconSetRule.Create;
rule.IconSet := AIconset;
n := rule.IconCount;
if n <> 4 then begin
rule.Free;
Result := -1;
exit;
end;
rule.ValueKinds[0] := AValueKind1; rule.Values[0] := AValue1;
rule.ValueKinds[1] := AValueKind2; rule.Values[1] := AValue2;
rule.ValueKinds[2] := AValueKind3; rule.Values[2] := AValue3;
rule.ShowValue := not AHideValue;
rule.Reverse := AReverse;
Result := AddRule(ASheet, ARange, rule);
end;
{ Iconset conditional format for 5 icons, i.e. 4 values }
function TsConditionalFormatList.AddIconSetRule(ASheet: TsBasicWorksheet;
ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double; AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double; AValueKind4: TsCFValueKind; AValue4: Double;
AHideValue: Boolean = false; AReverse: Boolean = false): Integer;
var
rule: TsCFIconSetRule;
n: Integer;
begin
rule := TsCFIconSetRule.Create;
rule.IconSet := AIconset;
n := rule.IconCount;
if n <> 5 then begin
rule.Free;
Result := -1;
exit;
end;
rule.ValueKinds[0] := AValueKind1; rule.Values[0] := AValue1;
rule.ValueKinds[1] := AValueKind2; rule.Values[1] := AValue2;
rule.ValueKinds[2] := AValueKind3; rule.Values[2] := AValue3;
rule.ValueKinds[3] := AValueKind4; rule.Values[3] := AValue4;
rule.ShowValue := not AHideValue;
rule.Reverse := AReverse;
Result := AddRule(ASheet, ARange, rule);
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Deletes the conditional format at the given index from the list. Deletes the conditional format at the given index from the list.
Iterates also through all cell in the range of the CF and removess the Iterates also through all cell in the range of the CF and removess the

View File

@@ -118,6 +118,7 @@ type
procedure ReadCFCellFormat(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFCellFormat(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadCFColorScale(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFColorScale(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadCFDataBars(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange); procedure ReadCFDataBars(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadCFIconSet(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadColumns(ATableNode: TDOMNode); procedure ReadColumns(ATableNode: TDOMNode);
procedure ReadColumnStyle(AStyleNode: TDOMNode); procedure ReadColumnStyle(AStyleNode: TDOMNode);
procedure ReadConditionalFormats(ANode: TDOMNode; AWorksheet: TsBasicWorksheet); procedure ReadConditionalFormats(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
@@ -425,6 +426,19 @@ const
'number' // vkValue 'number' // vkValue
); );
CF_ICON_SET: array[TsCFIconSet] of string = (
'3Arrows', '3ArrowsGray', '3Flags', // is3Arrows, is3ArrowsGray, is3Flags
'3TrafficLights1', '3TrafficLights2', // is3TrafficLights1, is3TrafficLights2
'3Signs', '3Symbols', '3Symbols2', // is3Signs, is3Symbols, is3Symbols2
'3Smilies', '3Stars', '3Triangles', // is3Smilies, is3Stars, is3Triangles
'3ColorSmilies', // is3ColorSmilies,
'4Arrows', '4ArrowsGray', // is4Arrows, is4ArrowsGray
'4RedToBlack', '4Rating', // is4RedToBlack, is4Rating,
'4RedToBlack', // is4TrafficLights, // not in ODS
'5Arrows', '5ArrowsGray', // is5Arrows, is5ArrowsGray
'5Rating', '5Quarters', '5Boxes' // is5Rating, is5Quarters, is5Boxes
);
function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String; function CFOperandToStr(v: variant; AWorksheet: TsWorksheet): String;
var var
r,c: Cardinal; r,c: Cardinal;
@@ -2205,6 +2219,7 @@ begin
'calcext:condition': ReadCFCellFormat(childNode, AWorksheet, range); 'calcext:condition': ReadCFCellFormat(childNode, AWorksheet, range);
'calcext:color-scale': ReadCFColorScale(childNode, AWorksheet, range); 'calcext:color-scale': ReadCFColorScale(childNode, AWorksheet, range);
'calcext:data-bar': ReadCFDataBars(childNode, AWorksheet, range); 'calcext:data-bar': ReadCFDataBars(childNode, AWorksheet, range);
'calcext:icon-set': ReadCFIconSet(childNode, AWorksheet, range);
end; end;
childNode := childNode.NextSibling; childNode := childNode.NextSibling;
end; end;
@@ -4072,6 +4087,74 @@ begin
); );
end; end;
procedure TsSpreadOpenDocReader.ReadCFIconSet(ANode: TDOMNode;
ASheet: TsBasicWorksheet; ARange: TsCellRange);
{ <calcext:icon-set calcext:icon-set-type="3Stars">
<calcext:formatting-entry calcext:value="0" calcext:type="percent" />
<calcext:formatting-entry calcext:value="33" calcext:type="percent" />
<calcext:formatting-entry calcext:value="66" calcext:type="percent" />
</calcext:icon-set> }
var
sheet: TsWorksheet;
nodeName: String;
s: String;
values: array of double = nil;
kinds: array of TsCFValueKind = nil;
iconSet, tmp: TsCFIconSet;
sIconSet: String;
found: Boolean;
n: Integer;
begin
if ANode = nil then
exit;
sIconSet := GetAttrValue(ANode, 'calcext:icon-set-type');
if sIconSet = '' then
exit;
for tmp in TsCFIconSet do
if sIconSet = CF_ICON_SET[tmp] then begin
iconSet := tmp;
found := true;
break;
end;
if (not found) then
exit;
// Number of icons
n := GetCFIconCount(iconSet);
if (n < 3) or (n > 5) then // only 3, 4 or 5 icons allowed
exit;
ANode := ANode.FirstChild;
while ANode <> nil do
begin
nodeName := ANode.NodeName;
if nodeName = 'calcext:formatting-entry' then
begin
s := GetAttrValue(ANode, 'calcext:value');
SetLength(values, Length(values)+1);
if not TryStrToFloat(s, values[High(values)], FPointSeparatorSettings) then
values[High(values)] := 0;
s := GetAttrValue(ANode, 'calcext:type');
SetLength(kinds, Length(kinds)+1);
kinds[High(kinds)] := StrToValueKind(s);
end;
ANode := ANode.NextSibling;
end;
sheet := TsWorksheet(ASheet);
// Ignore the first value because it is always 0
case n of
3: sheet.WriteIconSet(ARange, iconSet, kinds[1], values[1], kinds[2], values[2]);
4: sheet.WriteIconSet(ARange, iconSet, kinds[1], values[1], kinds[2], values[2], kinds[3], values[3]);
5: sheet.WriteIconSet(ARange, iconSet, kinds[1], values[1], kinds[2], values[2], kinds[3], values[3], kinds[4], values[4]);
end;
end;
{ Reads the cells in the given table. Loops through all rows, and then finds all { Reads the cells in the given table. Loops through all rows, and then finds all
cells of each row. } cells of each row. }
procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode); procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode);
@@ -6263,7 +6346,8 @@ var
cf_cellRule: TsCFCellRule; cf_cellRule: TsCFCellRule;
cf_DataBarRule: TsCFDataBarRule; cf_DataBarRule: TsCFDataBarRule;
cf_ColorRangeRule: TsCFColorRangeRule; cf_ColorRangeRule: TsCFColorRangeRule;
i,j: Integer; cf_IconSetRule: TsCFIconSetRule;
i, j, k: Integer;
sheet: TsWorksheet; sheet: TsWorksheet;
rangeStr: String; rangeStr: String;
firstCellStr: string; firstCellStr: string;
@@ -6358,6 +6442,24 @@ begin
CF_VALUE_KIND[cf_ColorRangeRule.EndValueKind], CF_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
ColorToHTMLColorStr(cf_ColorRangeRule.EndColor) ColorToHTMLColorStr(cf_ColorRangeRule.EndColor)
])); ]));
end else
if cf.Rules[j] is TsCFIconSetRule then
begin
cf_IconSetRule := TsCFIconSetRule(cf.Rules[j]);
AppendToStream(AStream, Format(
'<calcext:icon-set calcext:icon-set-type="%s">', [
CF_ICON_SET[cf_IconSetRule.IconSet]
]));
AppendToStream(AStream,
'<calcext:formatting-entry calcext:value="0" calcext:type="percent" />');
for k := 0 to cf_IconSetRule.IconCount-2 do
AppendToStream(AStream, Format(
'<calcext:formatting-entry calcext:value="%g" calcext:type="%s" />', [
cf_IconSetRule.Values[k],
CF_VALUE_KIND[cf_IconSetRule.ValueKinds[k]]
]));
AppendToStream(AStream,
'</calcext:icon-set>');
end; end;
end; end;

View File

@@ -405,6 +405,24 @@ type
function WriteDataBars(ARange: TsCellRange; ABarColor: TsColor; function WriteDataBars(ARange: TsCellRange; ABarColor: TsColor;
AStartKind: TsCFValueKind; AStartValue: Double; AStartKind: TsCFValueKind; AStartValue: Double;
AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload; AEndKind: TsCFValueKind; AEndValue: Double): Integer; overload;
// icon sets
function WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet;
AHideText: Boolean = false; AReverse: Boolean = false): Integer; overload;
function WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet; // 3 icons
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer; overload;
function WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet; // 4 icons
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer; overload;
function WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet; // 5 icons
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AValueKind4: TsCFValueKind; AValue4: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer; overload;
{ Formulas } { Formulas }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula; function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;

View File

@@ -143,6 +143,72 @@ begin
end; end;
{@@ ----------------------------------------------------------------------------
Writes the conditional format "icon set"
-------------------------------------------------------------------------------}
function TsWorksheet.WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet;
AHideText: Boolean = false; AReverse: Boolean = false): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddIconSetRule(Self, ARange,
AIconSet,
AHideText, AReverse);
StoreCFIndexInCells(self, Result, ARange);
end;
function TsWorksheet.WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddIconSetRule(Self, ARange,
AIconSet,
AValueKind1, AValue1,
AValueKind2, AValue2,
AHideText, AReverse
);
if Result <> -1 then
StoreCFIndexInCells(self, Result, ARange);
end;
function TsWorksheet.WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddIconSetRule(Self, ARange,
AIconSet,
AValueKind1, AValue1,
AValueKind2, AValue2,
AValueKind3, AValue3,
AHideText, AReverse
);
if Result <> -1 then
StoreCFIndexInCells(self, Result, ARange);
end;
function TsWorksheet.WriteIconSet(ARange: TsCellRange; AIconSet: TsCFIconSet;
AValueKind1: TsCFValueKind; AValue1: Double;
AValueKind2: TsCFValueKind; AValue2: Double;
AValueKind3: TsCFValueKind; AValue3: Double;
AValueKind4: TsCFValueKind; AValue4: Double;
AHideText: Boolean = false; AReverse: Boolean = false): Integer;
begin
Result := FWorkbook.FConditionalFormatList.AddIconSetRule(Self, ARange,
AIconSet,
AValueKind1, AValue1,
AValueKind2, AValue2,
AValueKind3, AValue3,
AValueKind4, AValue4,
AHideText, AReverse
);
if Result <> -1 then
StoreCFIndexInCells(self, Result, ARange);
end;
{==============================================================================} {==============================================================================}
{ TsWorkbook code for conditional formats } { TsWorkbook code for conditional formats }
{==============================================================================} {==============================================================================}

View File

@@ -82,6 +82,8 @@ type
ARange: TsCellRange); ARange: TsCellRange);
procedure ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; procedure ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer); ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFIconSet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange);
procedure ReadCFMisc(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; procedure ReadCFMisc(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer); ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFTop10(ANode: TDOMNode; AWorksheet: TsBasicWorksheet; procedure ReadCFTop10(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
@@ -159,18 +161,14 @@ type
function PrepareFormula(const AFormula: String): String; function PrepareFormula(const AFormula: String): String;
procedure ResetStreams; procedure ResetStreams;
procedure WriteBorderList(AStream: TStream); procedure WriteBorderList(AStream: TStream);
procedure WriteCFCellRule(AStream: TStream; ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer);
procedure WriteCFColorRangeRule(AStream: TStream; ARule: TsCFColorRangeRule; APriority: Integer);
procedure WriteCFDataBarRule(AStream: TStream; ARule: TsCFDatabarRule; APriority: Integer);
procedure WriteCFIconSetRule(AStream: TStream; ARule: TsCFIconSetRule; APriority: Integer);
procedure WriteColBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteColBreaks(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteComments(AWorksheet: TsBasicWorksheet); procedure WriteComments(AWorksheet: TsBasicWorksheet);
procedure WriteConditionalFormat(AStream: TStream; AFormat: TsConditionalFormat; var APriority: Integer); 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;
APriority: Integer);
procedure WriteConditionalFormatDataBarRule(AStream: TStream; ARule: TsCFDatabarRule;
APriority: Integer);
procedure WriteConditionalFormatRule(AStream: TStream; ARule: TsCFRule;
const ARange: TsCellRange; var APriority: Integer);
procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet); procedure WriteConditionalFormats(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteDefinedNames(AStream: TStream); procedure WriteDefinedNames(AStream: TStream);
procedure WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat); procedure WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat);
@@ -275,7 +273,7 @@ procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations)
implementation implementation
uses uses
variants, strutils, math, lazutf8, LazFileUtils, uriparser, variants, strutils, math, lazutf8, LazFileUtils, uriparser, typinfo,
{%H-}fpsPatches, fpSpreadsheet, fpsCrypto, fpsExprParser, {%H-}fpsPatches, fpSpreadsheet, fpsCrypto, fpsExprParser,
fpsStrings, fpsStreams, fpsClasses, fpsImages; fpsStrings, fpsStreams, fpsClasses, fpsImages;
@@ -446,6 +444,20 @@ const
'' // cfcExpression '' // cfcExpression
); );
CF_ICON_SET: array[TsCFIconSet] of string = (
'3Arrows', '3ArrowsGray','3Flags', // is3Arrows, is3ArrowsGray, is3Flags
'3TrafficLights2', // REPLACEMENT FOR is3TrafficLights1 which requires x14
'3TrafficLights', // is3TrafficLights2
'3Signs', '3Symbols', '3Symbols2', // is3Signs, is3Symbols, is3Symbols2
'3Signs', '3Signs', '3Signs', '3Signs', // REPLACEMENT FOR is3Smilies, is3Stars, is3Triangles, is3ColorSmilies which need x14
'4Arrows', '4ArrowsGray', // is4Arrows, is4ArrowsGray
'4RedToBlack', '4Rating', // is4RedToBlack, is4Rating
'4TrafficLights', // is4TrafficLights,
'5Arrows', '5ArrowsGray', // is5Arrows, is5ArrowsGray,
'5Rating', '5Quarters', // is5Rating, is5Quarters,
'5Quarters' // REPLACEMENT FOR is5Boxes which needs x14
);
function StrToFillStyle(s: String): TsFillStyle; function StrToFillStyle(s: String): TsFillStyle;
var var
fs: TsFillStyle; fs: TsFillStyle;
@@ -1533,6 +1545,79 @@ begin
end; end;
end; end;
procedure TsSpreadOOXMLReader.ReadCFIconSet(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; ARange: TsCellRange);
var
sheet: TsWorksheet;
s: String;
sIconSet: String;
iconSet: TsCFIconSet;
found: Boolean;
tmpIconSet: TsCFIconSet;
nodeName: String;
iv: Integer;
vk: array of TsCFValueKind = nil;
v: array of Double = nil;
n: Integer;
x: Double;
res: Integer;
begin
ANode := ANode.FirstChild;
if (ANode <> nil) and (ANode.NodeName = 'iconSet') then
begin
sIconSet := GetAttrValue(ANode, 'iconSet');
found := false;
for tmpIconSet in TsCFIconSet do
if 'is' + sIconSet = GetEnumName(typeInfo(TsCFIconSet), integer(tmpIconSet)) then
begin
iconSet := tmpIconSet;
found := true;
break;
end;
if (not found) or (sIconSet = '') then
Exit;
// Determine icon count from name of icon set
n := GetCFIconCount(iconSet);
if (n < 3) or (n > 5) then // only 3, 4 or 5 icons allowed
Exit;
SetLength(v, n);
SetLength(vk, n);
iv := 0;
ANode := ANode.FirstChild;
while (ANode <> nil) do
begin
nodeName := ANode.NodeName;
if (nodeName = 'cfvo') and (iv <= High(vk)) then
begin
s := GetAttrValue(ANode, 'type');
vk[iv] := StrToCFValueKind(s);
s := GetAttrValue(ANode, 'val');
if TryStrToFloat(s, x, FPointSeparatorSettings) then
v[iv] := x
else
v[iv] := 0.0;
inc(iv);
if iv >= n then
break;
end;
ANode := ANode.NextSibling;
end;
sheet := TsWorksheet(AWorksheet);
// Ignore the first value because it is always 0
case n of
3: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2]);
4: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2], vk[3], v[3]);
5: res := sheet.WriteIconSet(ARange, iconSet, vk[1], v[1], vk[2], v[2], vk[3], v[3], vk[4], v[4]);
end;
ANode := ANode.NextSibling;
end;
end;
procedure TsSpreadOOXMLReader.ReadCFMisc(ANode: TDOMNode; procedure TsSpreadOOXMLReader.ReadCFMisc(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer); AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer);
var var
@@ -1887,6 +1972,8 @@ begin
ReadCFColorRange(childNode, AWorksheet, range); ReadCFColorRange(childNode, AWorksheet, range);
'dataBar': 'dataBar':
ReadCFDataBars(childNode, AWorksheet, range); ReadCFDataBars(childNode, AWorksheet, range);
'iconSet':
ReadCFIconSet(childNode, AWorksheet, range);
end; end;
end; end;
childNode := childNode.NextSibling; childNode := childNode.NextSibling;
@@ -3913,6 +4000,203 @@ begin
'</borders>'); '</borders>');
end; end;
procedure TsSpreadOOXMLWriter.WriteCFCellRule(AStream: TStream;
ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer);
const
FORMULA: array[cfcBeginsWith..cfcNotContainsErrors] of String = (
'LEFT(%0:s,LEN("%1:s"))="%1:s"', // cfcBeginsWith
'RIGHT(%0:s,Len("%1:s"))="%1:s"', // cfcEndsWidth
'NOT(ISERROR(SEARCH("%1:s",%0:s)))', // cfcContainsText
'ISERROR(SEARCH("%1:s",%0:s))', // cfcNotContainsText
'ISERROR(%0:s)', // cfcContainsErrors
'NOT(ISERROR(%0:s))' // cfcNotContainsErrors
);
var
i: Integer;
dxfID: Integer;
typeStr, opStr, formula1Str, formula2Str, param1Str, param2Str, param3Str: String;
firstCellOfRange: String;
s: String;
begin
dxfID := -1;
for i := 0 to High(FDifferentialFormatIndexList) do
if FDifferentialFormatIndexList[i] = ARule.FormatIndex then
begin
dxfID := i;
break;
end;
typeStr := CF_TYPE_NAMES[ARule.Condition];
if CF_OPERATOR_NAMES[ARule.Condition] = '' then
opStr := ''
else
opStr := ' operator="' + CF_OPERATOR_NAMES[ARule.Condition] + '"';
formula1Str := '';
formula2Str := '';
param1Str := '';
param2Str := '';
param3Str := '';
case ARule.Condition of
cfcEqual..cfcNotBetween:
begin
s := CFOperandToStr(ARule.Operand1);
formula1Str := Format('<formula>%s</formula>', [s]);
if (ARule.Condition in [cfcBetween, cfcNotBetween]) then
begin
s := CFOperandToStr(ARule.Operand2);
formula2Str := Format('<formula>%s</formula>', [s]);
end;
end;
cfcAboveAverage..cfcBelowEqualAverage:
begin
if (ARule.Condition in [cfcBelowAverage, cfcBelowEqualAverage]) then
param1Str := ' aboveAverage="0"';
if (ARule.Condition in [cfcAboveEqualAverage, cfcBelowEqualAverage]) then
param2Str := ' equalAverage="1"';
if VarIsNumeric(ARule.Operand1) or (ARule.Operand1 = 0) then
param3Str := Format(' stdDev="%g"', [double(ARule.Operand1)]);
end;
cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent:
begin
// <cfRule type="top10" dxfId="0" priority="1" percent="1" bottom="1" rank="30" /> // = bottom 30 percent
if ARule.Condition in [cfcBottom, cfcBottomPercent] then
param1Str := ' bottom="1"';
if ARule.Condition in [cfcTopPercent, cfcBottomPercent] then
param2Str := ' percent="1"';
param3Str := ' rank="' + VarToStr(ARule.Operand1) + '"';
end;
cfcDuplicate, cfcUnique:
;
cfcBeginsWith..cfcNotContainsErrors:
begin
firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1);
formula1Str :=
'<formula>' +
Format(FORMULA[ARule.Condition], [firstcellOfRange, ARule.Operand1]) +
'</formula>';
param1Str := ' text="' + VarToStr(ARule.Operand1) + '"';
end;
cfcExpression:
begin
s := ARule.Operand1;
if (s <> '') and (s[1] = '=') then Delete(s, 1, 1);
formula1Str := '<formula>' + s + '</formula>';
end;
else
FWorkbook.AddErrorMsg('ConditionalFormat operator not supported.');
end;
if formula1Str = '' then
s := Format(
'<cfRule type="%s" dxfId="%d" priority="%d"%s%s%s%s />', [
typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str
])
else
s := Format(
'<cfRule type="%s" dxfId="%d" priority="%d"%s%s%s%s>' +
'%s%s' +
'</cfRule>', [
typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str,
formula1Str, formula2Str
]);
AppendToStream(AStream, s);
end;
procedure TsSpreadOOXMLWriter.WriteCFColorRangeRule(AStream: TStream;
ARule: TsCFColorRangeRule; 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> }
begin
AppendToStream(AStream,
'<cfRule type="colorScale" priority="' + IntToStr(APriority) + '">' +
'<colorScale>');
AppendToStream(AStream,
CF_ValueNode(ARule.StartValueKind, ARule.StartValue),
IfThen(ARule.ThreeColors, CF_ValueNode(ARule.CenterValueKind, ARule.CenterValue), ''),
CF_ValueNode(ARule.EndValueKind, ARule.EndValue)
);
AppendToStream(AStream,
CF_ColorNode(ARule.StartColor),
IfThen(ARule.ThreeColors, CF_ColorNode(ARule.CenterColor), ''),
CF_ColorNode(ARule.EndColor)
);
AppendToStream(AStream,
'</colorScale>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteCFDatabarRule(AStream: TStream;
ARule: TsCFDataBarRule; 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.Color) );
AppendToStream(AStream,
'</dataBar>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteCFIconSetRule(AStream: TStream;
ARule: TsCFIconSetRule; APriority: Integer);
{ <cfRule type="iconSet" priority="13">
<iconSet iconSet="3Symbols2">
<cfvo type="percent" val="0" />
<cfvo type="percent" val="33" />
<cfvo type="percent" val="67" />
</iconSet>
</cfRule> }
var
i: Integer;
begin
AppendToStream(AStream, Format(
'<cfRule type="iconSet" priority="%d">' +
'<iconSet iconSet="%s">' +
'<cfvo type="percent" val="0" />', [
APriority, CF_ICON_SET[Arule.IconSet]
]));
for i := 0 to ARule.IconCount-2 do
AppendToStream(AStream,
CF_ValueNode(ARule.ValueKinds[i], ARule.Values[i])
);
AppendToStream(AStream,
'</iconSet>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteColBreaks(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteColBreaks(AStream: TStream;
AWorksheet: TsBasicWorksheet); AWorksheet: TsBasicWorksheet);
var var
@@ -4045,191 +4329,24 @@ begin
for i := 0 to AFormat.RulesCount-1 do for i := 0 to AFormat.RulesCount-1 do
begin begin
rule := AFormat.Rules[i]; rule := AFormat.Rules[i];
WriteConditionalFormatRule(AStream, rule, AFormat.CellRange, APriority); if rule is TsCFCellRule then
end; WriteCFCellRule(AStream, TsCFCellRule(rule), AFormat.CellRange, APriority)
AppendToStream(AStream,
'</conditionalFormatting>');
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormatCellRule(AStream: TStream;
ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer);
const
FORMULA: array[cfcBeginsWith..cfcNotContainsErrors] of String = (
'LEFT(%0:s,LEN("%1:s"))="%1:s"', // cfcBeginsWith
'RIGHT(%0:s,Len("%1:s"))="%1:s"', // cfcEndsWidth
'NOT(ISERROR(SEARCH("%1:s",%0:s)))', // cfcContainsText
'ISERROR(SEARCH("%1:s",%0:s))', // cfcNotContainsText
'ISERROR(%0:s)', // cfcContainsErrors
'NOT(ISERROR(%0:s))' // cfcNotContainsErrors
);
var
i: Integer;
dxfID: Integer;
typeStr, opStr, formula1Str, formula2Str, param1Str, param2Str, param3Str: String;
firstCellOfRange: String;
s: String;
begin
dxfID := -1;
for i := 0 to High(FDifferentialFormatIndexList) do
if FDifferentialFormatIndexList[i] = ARule.FormatIndex then
begin
dxfID := i;
break;
end;
typeStr := CF_TYPE_NAMES[ARule.Condition];
if CF_OPERATOR_NAMES[ARule.Condition] = '' then
opStr := ''
else else
opStr := ' operator="' + CF_OPERATOR_NAMES[ARule.Condition] + '"'; if rule is TsCFColorRangeRule then
formula1Str := ''; WriteCFColorRangeRule(AStream, TsCFColorRangeRule(rule), APriority)
formula2Str := '';
param1Str := '';
param2Str := '';
param3Str := '';
case ARule.Condition of
cfcEqual..cfcNotBetween:
begin
s := CFOperandToStr(ARule.Operand1);
formula1Str := Format('<formula>%s</formula>', [s]);
if (ARule.Condition in [cfcBetween, cfcNotBetween]) then
begin
s := CFOperandToStr(ARule.Operand2);
formula2Str := Format('<formula>%s</formula>', [s]);
end;
end;
cfcAboveAverage..cfcBelowEqualAverage:
begin
if (ARule.Condition in [cfcBelowAverage, cfcBelowEqualAverage]) then
param1Str := ' aboveAverage="0"';
if (ARule.Condition in [cfcAboveEqualAverage, cfcBelowEqualAverage]) then
param2Str := ' equalAverage="1"';
if VarIsNumeric(ARule.Operand1) or (ARule.Operand1 = 0) then
param3Str := Format(' stdDev="%g"', [double(ARule.Operand1)]);
end;
cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent:
begin
// <cfRule type="top10" dxfId="0" priority="1" percent="1" bottom="1" rank="30" /> // = bottom 30 percent
if ARule.Condition in [cfcBottom, cfcBottomPercent] then
param1Str := ' bottom="1"';
if ARule.Condition in [cfcTopPercent, cfcBottomPercent] then
param2Str := ' percent="1"';
param3Str := ' rank="' + VarToStr(ARule.Operand1) + '"';
end;
cfcDuplicate, cfcUnique:
;
cfcBeginsWith..cfcNotContainsErrors:
begin
firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1);
formula1Str :=
'<formula>' +
Format(FORMULA[ARule.Condition], [firstcellOfRange, ARule.Operand1]) +
'</formula>';
param1Str := ' text="' + VarToStr(ARule.Operand1) + '"';
end;
cfcExpression:
begin
s := ARule.Operand1;
if (s <> '') and (s[1] = '=') then Delete(s, 1, 1);
formula1Str := '<formula>' + s + '</formula>';
end;
else else
FWorkbook.AddErrorMsg('ConditionalFormat operator not supported.'); if rule is TsCFDataBarRule then
end; WriteCFDataBarRule(AStream, TsCFDataBarRule(rule), APriority)
if formula1Str = '' then
s := Format(
'<cfRule type="%s" dxfId="%d" priority="%d"%s%s%s%s />', [
typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str
])
else else
s := Format( if rule is TsCFIconSetRule then
'<cfRule type="%s" dxfId="%d" priority="%d"%s%s%s%s>' + WriteCFIconSetRule(AStream, TsCFIconSetRule(rule), APriority)
'%s%s' +
'</cfRule>', [
typeStr, dxfId, APriority, opStr, param1Str, param2Str, param3Str,
formula1Str, formula2Str
]);
AppendToStream(AStream, s);
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormatColorRangeRule(AStream: TStream;
ARule: TsCFColorRangeRule; 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> }
begin
AppendToStream(AStream,
'<cfRule type="colorScale" priority="' + IntToStr(APriority) + '">' +
'<colorScale>');
AppendToStream(AStream,
CF_ValueNode(ARule.StartValueKind, ARule.StartValue),
IfThen(ARule.ThreeColors, CF_ValueNode(ARule.CenterValueKind, ARule.CenterValue), ''),
CF_ValueNode(ARule.EndValueKind, ARule.EndValue)
);
AppendToStream(AStream,
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; 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.Color) );
AppendToStream(AStream,
'</dataBar>' +
'</cfRule>');
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormatRule(AStream: TStream;
ARule: TsCFRule; const ARange: TsCellRange; var APriority: Integer);
begin
if ARule is TsCFCellRule then
WriteConditionalFormatCellRule(AStream, TsCFCellRule(ARule), ARange, APriority)
else
if ARule is TsCFColorRangeRule then
WriteConditionalFormatColorRangeRule(AStream, TsCFColorRangeRule(ARule), APriority)
else
if ARule is TsCFDataBarRule then
WriteConditionalFormatDataBarRule(AStream, TsCFDataBarRule(ARule), APriority)
else else
exit; exit;
dec(APriority); dec(APriority);
end; end;
AppendToStream(AStream,
'</conditionalFormatting>');
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;
AWorksheet: TsBasicWorksheet); AWorksheet: TsBasicWorksheet);

View File

@@ -34,12 +34,18 @@ type
procedure TestWriteRead_CF_CellFmt(AFileFormat: TsSpreadsheetFormat; procedure TestWriteRead_CF_CellFmt(AFileFormat: TsSpreadsheetFormat;
ACondition: TsCFCondition; ACellFormat: TsCellFormat); ACondition: TsCFCondition; ACellFormat: TsCellFormat);
// Test color range format
procedure TestWriteRead_CF_ColorRange(AFileFormat: TsSpreadsheetFormat; procedure TestWriteRead_CF_ColorRange(AFileFormat: TsSpreadsheetFormat;
ThreeColors: Boolean; FullSyntax: Boolean); ThreeColors: Boolean; FullSyntax: Boolean);
// Test data bars format
procedure TestWriteRead_CF_DataBars(AFileFormat: TsSpreadsheetFormat; procedure TestWriteRead_CF_DataBars(AFileFormat: TsSpreadsheetFormat;
FullSyntax: Boolean); FullSyntax: Boolean);
// Test icon set format
procedure TestWriteRead_CF_IconSet(AFileFormat: TsSpreadsheetFormat;
AIconSet: TsCFIconSet; FullSyntax: Boolean);
published published
{ Excel XLSX } { Excel XLSX }
procedure TestWriteRead_CF_CellFmt_XLSX_Equal_Const; procedure TestWriteRead_CF_CellFmt_XLSX_Equal_Const;
@@ -81,6 +87,10 @@ type
procedure TestWriteRead_CF_Databars_XLSX_Full; procedure TestWriteRead_CF_Databars_XLSX_Full;
procedure TestWriteRead_CF_Databars_XLSX_Simple; procedure TestWriteRead_CF_Databars_XLSX_Simple;
procedure TestWriteRead_CF_Iconset_XLSX_Full_5Quarters;
procedure TestWriteRead_CF_IconSet_XLSX_Simple_3Arrows;
procedure TestWriteRead_CF_IconSet_XLSX_Simple_5Rating;
{ Excel XML } { Excel XML }
procedure TestWriteRead_CF_CellFmt_XML_Equal_Const; procedure TestWriteRead_CF_CellFmt_XML_Equal_Const;
procedure TestWriteRead_CF_CellFmt_XML_NotEqual_Const; procedure TestWriteRead_CF_CellFmt_XML_NotEqual_Const;
@@ -151,6 +161,9 @@ type
procedure TestWriteRead_CF_Databars_ODS_Full; procedure TestWriteRead_CF_Databars_ODS_Full;
procedure TestWriteRead_CF_Databars_ODS_Simple; procedure TestWriteRead_CF_Databars_ODS_Simple;
procedure TestWriteRead_CF_Iconset_ODS_Full_5Quarters;
procedure TestWriteRead_CF_IconSet_ODS_Simple_3Arrows;
procedure TestWriteRead_CF_IconSet_ODS_Simple_5Rating;
end; end;
implementation implementation
@@ -1541,6 +1554,188 @@ begin
end; end;
{-------------------------------------------------------------------------------
IconSet tests
-------------------------------------------------------------------------------}
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_IconSet(
AFileFormat: TsSpreadsheetFormat; AIconSet: TsCFIconSet; FullSyntax: Boolean);
const
SHEET_NAME = 'CF';
SOLL_VALUE_KIND_1 = vkValue;
SOLL_VALUE_KIND_2 = vkPercent;
SOLL_VALUE_KIND_3 = vkPercentile;
SOLL_VALUE_KIND_4 = vkPercent;
SOLL_VALUE_1 = 15;
SOLL_VALUE_2 = 42;
SOLL_VALUE_3 = 62;
SOLL_VALUE_4 = 85;
var
worksheet: TsWorksheet;
workbook: TsWorkbook;
row, col: Cardinal;
tempFile: string;
cf: TsConditionalFormat;
rule: TsCFIconSetRule;
sollRange: TsCellRange;
actRange: TsCellRange;
actIconSet: TsCFIconSet;
n: Integer;
begin
// Write out all test values
workbook := TsWorkbook.Create;
try
workbook.Options := [boAutoCalc];
workSheet:= workBook.AddWorksheet(SHEET_NAME);
// Add test cells (numeric)
row := 0;
for Col := 0 to 9 do
worksheet.WriteNumber(row, col, col*10.0);
// Write conditional formats
sollRange := Range(0, 0, 0, 9);
if FullSyntax then
begin
n := GetCFIconCount(AIconSet);
case n of
3: worksheet.WriteIconSet(sollRange, AIconSet, SOLL_VALUE_KIND_1, SOLL_VALUE_1, SOLL_VALUE_KIND_2, SOLL_VALUE_2);
4: worksheet.WriteIconSet(sollRange, AIconSet, SOLL_VALUE_KIND_1, SOLL_VALUE_1, SOLL_VALUE_KIND_2, SOLL_VALUE_2, SOLL_VALUE_KIND_3, SOLL_VALUE_3);
5: worksheet.WriteIconSet(sollRange, AIconSet, SOLL_VALUE_KIND_1, SOLL_VALUE_1, SOLL_VALUE_KIND_2, SOLL_VALUE_2, SOLL_VALUE_KIND_3, SOLL_VALUE_3, SOLL_VALUE_KIND_4, SOLL_VALUE_4);
end;
end else
worksheet.WriteIconSet(sollRange, AIconSet);
// Save to file
tempFile := NewTempFile;
workBook.WriteToFile(tempFile, AFileFormat, true);
finally
workbook.Free;
end;
// Open the spreadsheet
workbook := TsWorkbook.Create;
try
workbook.ReadFromFile(TempFile, AFileFormat);
worksheet := GetWorksheetByName(workBook, SHEET_NAME);
if worksheet=nil then
fail('Error in test code. Failed to get named worksheet');
// Check count of conditional formats
CheckEquals(1, workbook.GetNumConditionalFormats, 'ConditionalFormat count mismatch.');
// Read conditional format
cf := Workbook.GetConditionalFormat(0);
//Check range
actRange := cf.CellRange;
CheckEquals(sollRange.Row1, actRange.Row1, 'Conditional format range mismatch (Row1)');
checkEquals(sollRange.Col1, actRange.Col1, 'Conditional format range mismatch (Col1)');
CheckEquals(sollRange.Row2, actRange.Row2, 'Conditional format range mismatch (Row2)');
checkEquals(sollRange.Col2, actRange.Col2, 'Conditional format range mismatch (Col2)');
// Check rules count
CheckEquals(1, cf.RulesCount, 'Conditional format rules count mismatch');
// Check rules class
CheckEquals(TsCFIconSetRule, cf.Rules[0].ClassType, 'Conditional format rule class mismatch');
// Now know that the rule is a TsCFIconsetRule
rule := TsCFIconSetRule(cf.Rules[0]);
// Check icon set
actIconSet := rule.IconSet;
CheckEquals(
GetEnumName(TypeInfo(TsCFIconSet), Integer(AIconSet)),
GetEnumName(TypeInfo(TsCFIconSet), Integer(actIconSet)),
'IconSet format: icon set mismatch');
// Parameters
if FullSyntax then
begin
CheckEquals(
GetEnumName(TypeInfo(TsCFValueKind), integer(SOLL_VALUE_KIND_1)),
GetEnumName(TypeInfo(TsCFValueKind), integer(rule.ValueKinds[0])),
'IconSet format: value kind 0 mismatch.'
);
if not (SOLL_VALUE_KIND_1 in [vkMin, vkMax]) then
CheckEquals(SOLL_VALUE_1, rule.Values[0], 'IconSet format: value 0 mismatch');
CheckEquals(
GetEnumName(TypeInfo(TsCFValueKind), integer(SOLL_VALUE_KIND_2)),
GetEnumName(TypeInfo(TsCFValueKind), integer(rule.ValueKinds[1])),
'IconSet format: value kind 1 mismatch.'
);
if not (SOLL_VALUE_KIND_2 in [vkMin, vkMax]) then
CheckEquals(SOLL_VALUE_2, rule.Values[1], 'IconSet format: value 1 mismatch');
if n > 2 then
begin
CheckEquals(
GetEnumName(TypeInfo(TsCFValueKind), integer(SOLL_VALUE_KIND_3)),
GetEnumName(TypeInfo(TsCFValueKind), integer(rule.ValueKinds[2])),
'IconSet format: value kind 2 mismatch.'
);
if not (SOLL_VALUE_KIND_3 in [vkMin, vkMax]) then
CheckEquals(SOLL_VALUE_3, rule.Values[2], 'IconSet format: value 2 mismatch');
end;
if n = 3 then
begin
CheckEquals(
GetEnumName(TypeInfo(TsCFValueKind), integer(SOLL_VALUE_KIND_4)),
GetEnumName(TypeInfo(TsCFValueKind), integer(rule.ValueKinds[3])),
'IconSet format: value kind 3 mismatch.'
);
if not (SOLL_VALUE_KIND_4 in [vkMin, vkMax]) then
CheckEquals(SOLL_VALUE_4, rule.Values[3], 'IconSet format: value 3 mismatch');
end;
end;
finally
workbook.Free;
DeleteFile(tempFile);
end;
end;
{ Excel XLSX }
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_Iconset_XLSX_Full_5Quarters;
begin
TestWriteRead_CF_IconSet(sfOOXML, is5Quarters, true);
end;
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_IconSet_XLSX_Simple_3Arrows;
begin
TestWriteRead_CF_IconSet(sfOOXML, is3Arrows, false);
end;
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_IconSet_XLSX_Simple_5Rating;
begin
TestWriteRead_CF_IconSet(sfOOXML, is5Rating, false);
end;
{ OpenDocument }
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_Iconset_ODS_Full_5Quarters;
begin
TestWriteRead_CF_IconSet(sfOpenDocument, is5Quarters, true);
end;
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_IconSet_ODS_Simple_3Arrows;
begin
TestWriteRead_CF_IconSet(sfOpenDocument, is3Arrows, false);
end;
procedure TSpreadWriteReadCFTests.TestWriteRead_CF_IconSet_ODS_Simple_5Rating;
begin
TestWriteRead_CF_IconSet(sfOpenDocument, is5Rating, false);
end;
initialization initialization
RegisterTest(TSpreadWriteReadCFTests); RegisterTest(TSpreadWriteReadCFTests);

View File

@@ -1,13 +1,11 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="12"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="spreadtestgui"/> <Title Value="spreadtestgui"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
</General> </General>