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

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -26,7 +26,7 @@ begin
sh.WriteText(0, 2, 'Test values');
row := 2;
for i := row to row+30 do
for i := row to row+33 do
begin
sh.WriteNumber(i, 2, 1.0);
sh.WriteNumber(i, 3, 2.0);
@@ -324,6 +324,12 @@ begin
sh.WriteText(row, 1, 'yellow -> red');
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-------------------------------------------- }
wb.WriteToFile('test.xlsx', true);
wb.WriteToFile('test.ods', true);

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

@@ -68,6 +68,41 @@ type
procedure Assign(ASource: TsCFRule); override;
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 }
TsCFRules = class(TFPObjectList)
private
@@ -127,17 +162,44 @@ type
ABarColor: TsColor; AStartKind: TsCFValueKind; AStartValue: Double;
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);
function Find(ASheet: TsBasicWorksheet; ARange: TsCellRange): Integer;
end;
function GetCFIconCount(AIconSet: TsCFIconSet): Integer;
implementation
uses
Math,
Math, TypInfo,
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);
begin
if ASource is TsCFCellRule then
@@ -164,7 +226,7 @@ begin
begin
//
end else
raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
raise Exception.Create('Source cannot be assigned to TsCFDataBarRule');
end;
constructor TsCFColorRangeRule.Create;
@@ -194,7 +256,7 @@ begin
CenterColor := TsCFColorRangeRule(ASource).CenterColor;
EndColor := TsCFColorRangeRule(ASource).EndColor;
end else
raise Exception.Create('Source cannot be assigned to TCVDataBarRule');
raise Exception.Create('Source cannot be assigned to TsCFColorRangeRule');
end;
procedure TsCFColorRangeRule.SetupCenter(AColor: TsColor;
@@ -222,8 +284,89 @@ begin
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;
begin
@@ -424,6 +567,115 @@ begin
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.
Iterates also through all cell in the range of the CF and removess the

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

@@ -118,6 +118,7 @@ type
procedure ReadCFCellFormat(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadCFColorScale(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 ReadColumnStyle(AStyleNode: TDOMNode);
procedure ReadConditionalFormats(ANode: TDOMNode; AWorksheet: TsBasicWorksheet);
@@ -425,6 +426,19 @@ const
'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;
var
r,c: Cardinal;
@@ -2205,6 +2219,7 @@ begin
'calcext:condition': ReadCFCellFormat(childNode, AWorksheet, range);
'calcext:color-scale': ReadCFColorScale(childNode, AWorksheet, range);
'calcext:data-bar': ReadCFDataBars(childNode, AWorksheet, range);
'calcext:icon-set': ReadCFIconSet(childNode, AWorksheet, range);
end;
childNode := childNode.NextSibling;
end;
@@ -4072,6 +4087,74 @@ begin
);
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
cells of each row. }
procedure TsSpreadOpenDocReader.ReadRowsAndCells(ATableNode: TDOMNode);
@@ -6263,7 +6346,8 @@ var
cf_cellRule: TsCFCellRule;
cf_DataBarRule: TsCFDataBarRule;
cf_ColorRangeRule: TsCFColorRangeRule;
i,j: Integer;
cf_IconSetRule: TsCFIconSetRule;
i, j, k: Integer;
sheet: TsWorksheet;
rangeStr: String;
firstCellStr: string;
@@ -6358,6 +6442,24 @@ begin
CF_VALUE_KIND[cf_ColorRangeRule.EndValueKind],
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;

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

@@ -405,6 +405,24 @@ type
function WriteDataBars(ARange: TsCellRange; ABarColor: TsColor;
AStartKind: TsCFValueKind; AStartValue: Double;
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 }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;

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

@@ -143,6 +143,72 @@ begin
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 }
{==============================================================================}

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

@@ -82,6 +82,8 @@ type
ARange: TsCellRange);
procedure ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFIconSet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange);
procedure ReadCFMisc(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFTop10(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
@@ -159,18 +161,14 @@ type
function PrepareFormula(const AFormula: String): String;
procedure ResetStreams;
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 WriteCols(AStream: TStream; AWorksheet: TsBasicWorksheet);
procedure WriteComments(AWorksheet: TsBasicWorksheet);
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 WriteDefinedNames(AStream: TStream);
procedure WriteDifferentialFormat(AStream: TStream; AFormat: PsCellFormat);
@@ -275,7 +273,7 @@ procedure InitOOXMLLimitations(out ALimitations: TsSpreadsheetFormatLimitations)
implementation
uses
variants, strutils, math, lazutf8, LazFileUtils, uriparser,
variants, strutils, math, lazutf8, LazFileUtils, uriparser, typinfo,
{%H-}fpsPatches, fpSpreadsheet, fpsCrypto, fpsExprParser,
fpsStrings, fpsStreams, fpsClasses, fpsImages;
@@ -446,6 +444,20 @@ const
'' // 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;
var
fs: TsFillStyle;
@@ -1533,6 +1545,79 @@ begin
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;
AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer);
var
@@ -1887,6 +1972,8 @@ begin
ReadCFColorRange(childNode, AWorksheet, range);
'dataBar':
ReadCFDataBars(childNode, AWorksheet, range);
'iconSet':
ReadCFIconSet(childNode, AWorksheet, range);
end;
end;
childNode := childNode.NextSibling;
@@ -3913,6 +4000,203 @@ begin
'</borders>');
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;
AWorksheet: TsBasicWorksheet);
var
@@ -4045,192 +4329,25 @@ begin
for i := 0 to AFormat.RulesCount-1 do
begin
rule := AFormat.Rules[i];
WriteConditionalFormatRule(AStream, rule, AFormat.CellRange, APriority);
if rule is TsCFCellRule then
WriteCFCellRule(AStream, TsCFCellRule(rule), AFormat.CellRange, APriority)
else
if rule is TsCFColorRangeRule then
WriteCFColorRangeRule(AStream, TsCFColorRangeRule(rule), APriority)
else
if rule is TsCFDataBarRule then
WriteCFDataBarRule(AStream, TsCFDataBarRule(rule), APriority)
else
if rule is TsCFIconSetRule then
WriteCFIconSetRule(AStream, TsCFIconSetRule(rule), APriority)
else
exit;
dec(APriority);
end;
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
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.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
exit;
dec(APriority);
end;
procedure TsSpreadOOXMLWriter.WriteConditionalFormats(AStream: TStream;
AWorksheet: TsBasicWorksheet);
var

195
components/fpspreadsheet/tests/conditionalformattests.pas
View File

@@ -34,12 +34,18 @@ type
procedure TestWriteRead_CF_CellFmt(AFileFormat: TsSpreadsheetFormat;
ACondition: TsCFCondition; ACellFormat: TsCellFormat);
// Test color range format
procedure TestWriteRead_CF_ColorRange(AFileFormat: TsSpreadsheetFormat;
ThreeColors: Boolean; FullSyntax: Boolean);
// Test data bars format
procedure TestWriteRead_CF_DataBars(AFileFormat: TsSpreadsheetFormat;
FullSyntax: Boolean);
// Test icon set format
procedure TestWriteRead_CF_IconSet(AFileFormat: TsSpreadsheetFormat;
AIconSet: TsCFIconSet; FullSyntax: Boolean);
published
{ Excel XLSX }
procedure TestWriteRead_CF_CellFmt_XLSX_Equal_Const;
@@ -81,6 +87,10 @@ type
procedure TestWriteRead_CF_Databars_XLSX_Full;
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 }
procedure TestWriteRead_CF_CellFmt_XML_Equal_Const;
procedure TestWriteRead_CF_CellFmt_XML_NotEqual_Const;
@@ -151,6 +161,9 @@ type
procedure TestWriteRead_CF_Databars_ODS_Full;
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;
implementation
@@ -1541,6 +1554,188 @@ begin
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
RegisterTest(TSpreadWriteReadCFTests);

6
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

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