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

fpsprreadsheet: Add conditional date formats, read/write support for XLSX, ODS, ExcelXML. Add unit tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7587 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-07-29 16:55:45 +00:00
parent e0503c6d48
commit aebb067738
8 changed files with 529 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,6 +24,9 @@ type
cfcBeginsWith, cfcEndsWith,
cfcContainsText, cfcNotContainsText,
cfcContainsErrors, cfcNotContainsErrors,
cfcYesterday, cfcToday, cfcTomorrow, cfcLast7Days,
cfcLastWeek, cfcThisWeek, cfcNextWeek,
cfcLastMonth, cfcThisMonth, cfcNextMonth,
cfcExpression
);

73
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 ReadCFDateFormat(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadCFIconSet(ANode: TDOMNode; ASheet: TsBasicWorksheet; ARange: TsCellRange);
procedure ReadColumns(ATableNode: TDOMNode);
procedure ReadColumnStyle(AStyleNode: TDOMNode);
@ -405,6 +406,9 @@ const
'', '', // cfcDuplicate, cfcUnique,
'', '', '', '', // cfcBeginsWith, cfcEndsWith, cfcContainsText, cfcNotContainsText,
'', '', // cfcContainsErrors, cfcNotContainsErrors
'', '', '', '', // cfcYesterday .. cfcLast7Days
'', '', '', // cfcLastWeek .. cfcNextWeek
'', '', '', // cfcLastMonth .. cfcNextMonth
'is-true-formula(%s)' // cfcExpression
);
@ -421,8 +425,11 @@ const
'begins-with(%s)', 'ends-with(%s)', // cfcBeginsWith, cfcEndsWith,
'contains-text(%s)', 'not-contains-text(%s)', // cfcContainsText, cfcNotContainsText,
'is-error', 'is-no-error', // cfcContainsErrors, cfcNotContainsErrors
'yesterday', 'today', 'tomorrow', 'last-7-days', // cfcYesterday .. cfcLast7Days
'last-week', 'this-week', 'next-week', // cfcLastWeek .. cfcNextWeek
'last-month', 'this-month', 'next-month', // cfcLastMonth .. cfcNextMonth
'formula-is(%s)' // cfcExprssion
);
); // ???????????????????
CF_VALUE_KIND: array[TsCFValueKind] of string = (
'', // vkNone
@ -2265,6 +2272,7 @@ begin
nodeName := childNode.NodeName;
case nodeName of
'calcext:condition': ReadCFCellFormat(childNode, AWorksheet, range);
'calcext:date-is': ReadCFDateFormat(childNode, AWorksheet, range);
'calcext:color-scale': ReadCFColorScale(childNode, AWorksheet, range);
'calcext:data-bar': ReadCFDataBars(childNode, AWorksheet, range);
'calcext:icon-set': ReadCFIconSet(childNode, AWorksheet, range);
@ -4147,6 +4155,51 @@ begin
);
end;
procedure TsSpreadOpenDocReader.ReadCFDateFormat(ANode: TDOMNode;
ASheet: TsBasicWorksheet; ARange: TsCellRange);
var
sheet: TsWorksheet;
s: String;
c, condition: TsCFCondition;
found: Boolean = false;
fmt: TsCellFormat;
fmtIndex: Integer;
begin
if ANode = nil then
exit;
sheet := TsWorksheet(ASheet);
// Style
s := GetAttrValue(ANode, 'calcext:style');
if s <> '' then
begin
fmtIndex := ExtractFormatIndexFromStyle(s, -1);
fmt := FCellFormatList.Items[fmtIndex]^;
fmtIndex := (FWorkbook as TsWorkbook).AddCellFormat(fmt);
end;
// value to compare with
s := GetAttrValue(ANode, 'calcext:date');
if s = '' then
exit;
// condition for comparison
for c in [cfcYesterday..cfcNextMonth] do
if CF_CALCEXT_OP[c] = s then
begin
condition := c;
found := true;
break;
end;
if not found then
exit;
// Write conditional format to worksheet
sheet.WriteConditionalCellFormat(ARange, condition, fmtIndex);
end;
procedure TsSpreadOpenDocReader.ReadCFIconSet(ANode: TDOMNode;
ASheet: TsBasicWorksheet; ARange: TsCellRange);
{ <calcext:icon-set calcext:icon-set-type="3Stars">
@ -6459,6 +6512,8 @@ procedure TsSpreadOpenDocWriter.WriteConditionalFormats(AStream: TStream;
<calcext:condition calcext:apply-style-name="cf" calcext:value="=5" calcext:base-cell-address="Tabelle1.B4" />
</calcext:conditional-format>
</calcext:conditional-formats> }
const
VALUE_OR_DATE: array[boolean] of string = ('value', 'date');
var
book: TsWorkbook;
ncf: Integer;
@ -6475,6 +6530,7 @@ var
firstCellStr: string;
value1Str, value2Str: String;
opStr: String;
isDateFmt: Boolean;
begin
book := TsWorkbook(FWorkbook);
sheet := TsWorksheet(ASheet);
@ -6505,12 +6561,19 @@ begin
value1Str := CFOperandToStr(cf_cellRule.Operand1, sheet);
value2Str := CFOperandToStr(cf_cellRule.Operand2, sheet);
opStr := Format(CF_CALCEXT_OP[cf_cellRule.Condition], [value1Str, value2str]);
isDateFmt := cf_cellRule.Condition in [cfcYesterday..cfcNextMonth];
if opStr <> '' then
begin
AppendToStream(AStream, Format(
'<calcext:condition calcext:apply-style-name="%s" calcext:value="%s" calcext:base-cell-address="%s" />',
[cf_stylename, opStr, firstCellStr]
));
if isDateFmt then
AppendToStream(AStream, Format(
'<calcext:date-is calcext:style="%s" calcext:date="%s" />',
[cf_stylename, opStr]
))
else
AppendToStream(AStream, Format(
'<calcext:condition calcext:apply-style-name="%s" calcext:value="%s" calcext:base-cell-address="%s" />',
[cf_stylename, opStr, firstCellStr]
));
end;
end
else

44
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -235,15 +235,25 @@ const
'@RC&lt;=AVERAGE( IF(ISERROR(%2:s), &quot;&quot;, IF(ISBLANK(%2:s), &quot;&quot;, %2:s)))', // cfcBelowEqualAverage
// The next 4 formulas are not supported by Excel-XML
'', '', '', '', // cfcTop, cfcBottom, cfcTopPercent, cfcBottomPercent,
'@AND(COUNTIF(%2:s, RC)&gt;1,NOT(ISBLANK(RC)))', // cfcDuplicate
'@AND(COUNTIF(%2:s, RC)=1,NOT(ISBLANK(RC)))', // cfcUnique
'@LEFT(RC,LEN(%0:s))=%0:s', // cfcBeginsWith
'@RIGHT(RC,LEN(%0:s))=%0:s', // cfcEndsWith
'@NOT(ISERROR(SEARCH(%0:s,RC)))', // cfcContainsText
'@ISERROR(SEARCH(%0:s,RC))', // cfcNotContainsText,
'@ISERROR(RC)', // cfcContainsErrors
'@NOT(ISERROR(RC))', // cfcNotContainsErrors
'@' // cfcExpression
'@AND(COUNTIF(%2:s, RC)&gt;1,NOT(ISBLANK(RC)))', // cfcDuplicate
'@AND(COUNTIF(%2:s, RC)=1,NOT(ISBLANK(RC)))', // cfcUnique
'@LEFT(RC,LEN(%0:s))=%0:s', // cfcBeginsWith
'@RIGHT(RC,LEN(%0:s))=%0:s', // cfcEndsWith
'@NOT(ISERROR(SEARCH(%0:s,RC)))', // cfcContainsText
'@ISERROR(SEARCH(%0:s,RC))', // cfcNotContainsText,
'@ISERROR(RC)', // cfcContainsErrors
'@NOT(ISERROR(RC))', // cfcNotContainsErrors
'@FLOOR(RC,1)=TODAY()-1', // cfcYesterday
'@FLOOR(RC,1)=TODAY()', // cfcToday
'@FLOOR(RC,1)=TODAY()+1', // cfcTomorrow
'@AND(TODAY()-FLOOR(RC,1)&lt;=6,FLOOR(RC,1)&lt;=TODAY())', // cfcLast7Days
'@AND(TODAY()-ROUNDDOWN(RC,0)&gt;=(WEEKDAY(TODAY())),TODAY()-ROUNDDOWN(RC,0)&lt;(WEEKDAY(TODAY())+7))', // cfcLastWeek
'@AND(TODAY()-ROUNDDOWN(RC,0)&lt;=WEEKDAY(TODAY())-1,ROUNDDOWN(RC,0)-TODAY()&lt;=7-WEEKDAY(TODAY()))', // cfcThisWeek
'@AND(ROUNDDOWN(RC,0)-TODAY()&gt;(7-WEEKDAY(TODAY())),ROUNDDOWN(RC,0)-TODAY()&lt;(15-WEEKDAY(TODAY())))', // cfcNextWeek
'@AND(MONTH(RC)=MONTH(EDATE(TODAY(),0-1)),YEAR(RC)=YEAR(EDATE(TODAY(),0-1)))', // cfcLastMonth
'@AND(MONTH(RC)=MONTH(TODAY()),YEAR(RC)=YEAR(TODAY()))', // cfcThisMonth
'@AND(MONTH(RC)=MONTH(EDATE(TODAY(),0+1)),YEAR(RC)=YEAR(EDATE(TODAY(),0+1)))', // cfcNextMonth
'@' // cfcExpression
);
// The leading '@' indicates that the formula will be used in <Value1> node
// Parameter 0 is Operand1, parameter 1 is Operand2 and parameter 2 is Range
@ -366,6 +376,8 @@ procedure AnalyzeCFExpression(AExpr: String; out ACondition: TsCFCondition;
out AParam: String);
var
p, n: Integer;
c: TsCFCondition;
expr: String;
begin
AParam := '';
//AExpr := UTF8TextToXMLText(AExpr);
@ -415,13 +427,15 @@ begin
n := Length('ISERROR(SEARCH(');
AParam := UnquoteStr(Trim(Copy(AExpr, n+1, p-n-1)));
end else
if AExpr = 'ISERROR(RC)' then
ACondition := cfcContainsErrors
else
if AExpr = 'NOT(ISERROR(RC))' then
ACondition := cfcNotContainsErrors
else
begin
expr := '@' + UTF8TextToXMLText(AExpr);
for c in [cfcContainsErrors..cfcNextMonth] do
if CF_CONDITIONS[c] = expr then
begin
ACondition := c;
exit;
end;
ACondition := cfcExpression;
AParam := AExpr;
end;

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

@ -80,6 +80,8 @@ type
ARange: TsCellRange);
procedure ReadCFDataBars(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange);
procedure ReadCFDateFormat(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFExpression(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
ARange: TsCellRange; AFormatIndex: Integer);
procedure ReadCFIconSet(ANode: TDOMNode; AWorksheet: TsBasicWorksheet;
@ -436,6 +438,10 @@ const
'beginsWith', 'endsWith', // cfcBeginsWith, cfcEndsWith,
'containsText', 'notContainsText', // cfcContainsText, cfcNotContainsText,
'containsErrors', 'notContainsErrors', // cfcContainsErrors, cfcNotContainsErrors
'timePeriod', 'timePeriod', 'timePeriod',// cfcYesterday, cfcToday, cfcTomorrow
'timePeriod', // cfcLast7Days
'timePeriod', 'timePeriod', 'timePeriod',// cfcLastWeek, cfcThisWeek, cfcNextWeek
'timePeriod', 'timePeriod', 'timePeriod',// cfcLastMonth, cfcThisMonth, cfcNextMonth
'expression' // cfcExpression
);
@ -447,6 +453,9 @@ const
'', '', // cfcDuplicate, cfcUnique,
'', '', '', 'notContains', //cfcBeginsWith, cfcEndsWith, cfcContainsText, cfcNotContainsText,
'', '', // cfcContainsErrors, cfcNotContainsErrors
'yesterday', 'today', 'tomorrow', 'last7Days', // cfcYesterday, cfcToday, cfcTomorrow, cfcLast7Days
'lastWeek', 'thisWeek', 'nextWeek', // cfcLastWeek, cfcThisWeek, cfcNextWeek
'lastMonth', 'thisMonth', 'nextMonth', // cfcLastMonth, cfcThisMonth, cfcNextMonth
'' // cfcExpression
);
@ -1528,6 +1537,26 @@ begin
sheet.WriteDataBars(ARange, clr, vk[0], v[0], vk[1], v[1]);
end;
procedure TsSpreadOOXMLReader.ReadCFDateFormat(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer);
var
sheet: TsWorksheet;
s: String;
cond: TsCFCondition;
begin
if ANode = nil then
exit;
sheet := TsWorksheet(AWorksheet);
s := GetAttrValue(ANode, 'timePeriod');
for cond in [cfcYesterday..cfcNextMonth] do
if CF_OPERATOR_NAMES[cond] = s then
begin
sheet.WriteConditionalCellFormat(ARange, cond, AFormatIndex);
exit;
end;
end;
procedure TsSpreadOOXMLReader.ReadCFExpression(ANode: TDOMNode;
AWorksheet: TsBasicWorksheet; ARange: TsCellRange; AFormatIndex: Integer);
var
@ -1972,6 +2001,8 @@ begin
ReadCFMisc(childNode, AWorksheet, range, fmtIdx);
'containsText', 'notContainsText', 'beginsWith', 'endsWith':
ReadCFMisc(childNode, AWorksheet, range, fmtIdx);
'timePeriod':
ReadCFDateFormat(childNode, AWorksheet, range, fmtIdx);
'expression':
ReadCFExpression(childNode, AWorksheet, range, fmtIdx);
'colorScale':
@ -4064,13 +4095,23 @@ end;
procedure TsSpreadOOXMLWriter.WriteCFCellRule(AStream: TStream;
ARule: TsCFCellRule; ARange: TsCellRange; APriority: Integer);
const
FORMULA: array[cfcBeginsWith..cfcNotContainsErrors] of String = (
FORMULA: array[cfcBeginsWith..cfcNextMonth] 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
'NOT(ISERROR(%0:s))', // cfcNotContainsErrors
'FLOOR(%s,1)=TODAY()-1', // cfcYesterday
'FLOOR(%s,1)=TODAY()', // cfcToday
'FLOOR(%s,1)=TODAY()+1', // cfcTomorrow
'AND(TODAY()-FLOOR(%0:s,1)&lt;=6,FLOOR(%0:s,1)&lt;=TODAY())', // cfcLasst7Days
'AND(TODAY()-ROUNDDOWN(%0:s,0)&gt;=(WEEKDAY(TODAY())),TODAY()-ROUNDDOWN(%0:s,0)&lt;(WEEKDAY(TODAY())+7))', // cfcLastWeek
'AND(TODAY()-ROUNDDOWN(%0:s,0)&lt;=WEEKDAY(TODAY())-1,ROUNDDOWN(%0:s,0)-TODAY()&lt;=7-WEEKDAY(TODAY()))', // cfcThisWeek
'AND(ROUNDDOWN(%0:s,0)-TODAY()&gt;(7-WEEKDAY(TODAY())),ROUNDDOWN(C15,0)-TODAY()&lt;(15-WEEKDAY(TODAY())))', // cfcNextWeek
'AND(MONTH(%0:s)=MONTH(EDATE(TODAY(),0-1)),YEAR(%0:s)=YEAR(EDATE(TODAY(),0-1)))', // cfcLastMonth
'AND(MONTH(%0:s)=MONTH(TODAY()),YEAR(%0:s)=YEAR(TODAY()))', // cfcThisMonth
'AND(MONTH(%0:s)=MONTH(EDATE(TODAY(),0+1)),YEAR(%0:s)=YEAR(EDATE(TODAY(),0+1)))' // cfcNextMonth
);
var
i: Integer;
@ -4128,14 +4169,19 @@ begin
end;
cfcDuplicate, cfcUnique:
;
cfcBeginsWith..cfcNotContainsErrors:
cfcBeginsWith..cfcNextMonth:
begin
firstCellOfRange := GetCellString(ARange.Row1, ARange.Col1);
formula1Str :=
'<formula>' +
Format(FORMULA[ARule.Condition], [firstcellOfRange, ARule.Operand1]) +
'</formula>';
param1Str := ' text="' + VarToStr(ARule.Operand1) + '"';
if ARule.Condition >= cfcYesterday then
begin
param1Str := ' timePeriod="' + CF_OPERATOR_NAMES[ARule.Condition] + '"';
opStr := '';
end else
param1Str := ' text="' + VarToStr(ARule.Operand1) + '"';
end;
cfcExpression:
begin