fpspreadsheet: Cleanup
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9365 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
0af3201613
commit
09f442d20a
@ -28,6 +28,20 @@ type
|
|||||||
TsFuncType = (ftCountIF, ftCountIFS, ftSumIF, ftSUMIFS, ftAverageIF, ftAverageIFS);
|
TsFuncType = (ftCountIF, ftCountIFS, ftSumIF, ftSUMIFS, ftAverageIF, ftAverageIFS);
|
||||||
TsCompareType = (ctNumber, ctString, ctEmpty);
|
TsCompareType = (ctNumber, ctString, ctEmpty);
|
||||||
|
|
||||||
|
{ Helper class for calculating COUNTIF(S) or SUMIF(S) or AVERAGEIF(S) formulas.
|
||||||
|
|
||||||
|
Parameters are defined in the constructor:
|
||||||
|
- Args: array of TsExpressionParameters, provided by the expression parser.
|
||||||
|
- AValueRangeIndex: Index in Args defining the parameters for the range,
|
||||||
|
in which values are added for SUMIF(S), AVERAGEIF(S).
|
||||||
|
- ACriteriaRangeIndex: Index in Args defining the first range parameter
|
||||||
|
for comparing with the criterial.
|
||||||
|
- ACriteriaIndex: Index in Args defining the comparison expression, e.g. '>10'
|
||||||
|
- AFuncType: defines the function to be calculated.
|
||||||
|
|
||||||
|
In COUNTIFS, SUMIFS, AVERAGEIFS the criteria range and criteria parameters
|
||||||
|
can be repeated (up to 127, by Excel specification, not checked here).
|
||||||
|
}
|
||||||
TsFuncComparer = class
|
TsFuncComparer = class
|
||||||
private
|
private
|
||||||
FArgs: TsExprParameterArray;
|
FArgs: TsExprParameterArray;
|
||||||
@ -1771,312 +1785,6 @@ begin
|
|||||||
Result.ResInteger := n;
|
Result.ResInteger := n;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
const
|
|
||||||
rtCOUNT = 0;
|
|
||||||
rtSUM = 1;
|
|
||||||
rtAVG = 2;
|
|
||||||
|
|
||||||
procedure DoIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray;
|
|
||||||
ARangeIndex, AConditionRangeIndex, AConditionIndex, AResultType: Integer);
|
|
||||||
{ Helper function for COUNTIF or SUMIF or AVERAGEIF (depending on AReturnType,
|
|
||||||
see rtXXXX constants):
|
|
||||||
- Args[ARangeIndex] indicates the cell range in which cells will be counted,
|
|
||||||
added or averaged, when the condition is met.
|
|
||||||
- Args[AConditionRangeIndex] indicates the cell range which is compared
|
|
||||||
according to Args[ACondition]
|
|
||||||
- Args[ACondition] specifies the condition which is checked.
|
|
||||||
}
|
|
||||||
type
|
|
||||||
TCompareType = (ctEmpty, ctString, ctNumber);
|
|
||||||
var
|
|
||||||
condIdx, condRngIdx, n: Integer;
|
|
||||||
r, c: LongInt;
|
|
||||||
dr, dc: LongInt;
|
|
||||||
cell, addcell: PCell;
|
|
||||||
s: String;
|
|
||||||
f: Double;
|
|
||||||
dt: TDateTime;
|
|
||||||
book: TsWorkbook;
|
|
||||||
sheet0: TsWorksheet;
|
|
||||||
sheet2: TsWorksheet;
|
|
||||||
compareNumber: Double = 0.0;
|
|
||||||
compareStr: String = '';
|
|
||||||
compareOp: TsCompareOperation = coEqual;
|
|
||||||
compareType: TCompareType;
|
|
||||||
addNumber: Double;
|
|
||||||
fs: TFormatSettings;
|
|
||||||
count: Integer;
|
|
||||||
sum: Double;
|
|
||||||
|
|
||||||
procedure DoCompareNumber(ANumber, AAddNumber: Float);
|
|
||||||
var
|
|
||||||
ok: Boolean;
|
|
||||||
begin
|
|
||||||
ok := false;
|
|
||||||
case compareOp of
|
|
||||||
coEqual : if ANumber = compareNumber then ok := true;
|
|
||||||
coLess : if ANumber < compareNumber then ok := true;
|
|
||||||
coGreater : if ANumber > compareNumber then ok := true;
|
|
||||||
coLessEqual : if ANumber <= compareNumber then ok := true;
|
|
||||||
coGreaterEqual : if ANumber >= compareNumber then ok := true;
|
|
||||||
coNotEqual : if ANumber <> compareNumber then ok := true;
|
|
||||||
end;
|
|
||||||
if ok then
|
|
||||||
case AResultType of
|
|
||||||
rtCOUNT: inc(count);
|
|
||||||
rtSUM : sum := sum + AAddNumber;
|
|
||||||
rtAVG : begin inc(count); sum := sum + AAddNumber; end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure DoCompareString(AStr: String; AAddNumber: Float);
|
|
||||||
var
|
|
||||||
ok: Boolean;
|
|
||||||
begin
|
|
||||||
ok := false;
|
|
||||||
AStr := UTF8Lowercase(AStr);
|
|
||||||
case compareOp of
|
|
||||||
coEqual : if AStr = compareStr then ok := true;
|
|
||||||
coLess : if AStr < compareStr then ok := true;
|
|
||||||
coGreater : if AStr > compareStr then ok := true;
|
|
||||||
coLessEqual : if AStr <= compareStr then ok := true;
|
|
||||||
coGreaterEqual : if AStr >= compareStr then ok := true;
|
|
||||||
coNotEqual : if AStr <> compareStr then ok := true;
|
|
||||||
end;
|
|
||||||
if ok then
|
|
||||||
case AResultType of
|
|
||||||
rtCOUNT: inc(count);
|
|
||||||
rtSUM : sum := sum + AAddNumber;
|
|
||||||
rtAVG : begin inc(count); sum := sum + AAddNumber; end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure DoCompareEmpty(IsEmpty: Boolean; AAddNumber: Float);
|
|
||||||
var
|
|
||||||
ok: Boolean;
|
|
||||||
begin
|
|
||||||
ok := false;
|
|
||||||
case compareOp of
|
|
||||||
coEqual : if isEmpty then ok := true;
|
|
||||||
coNotEqual : if not isEmpty then ok := true;
|
|
||||||
end;
|
|
||||||
if ok then
|
|
||||||
case AResultType of
|
|
||||||
rtCOUNT: inc(count);
|
|
||||||
rtSUM : sum := sum + AAddNumber;
|
|
||||||
rtAVG : begin inc(count); sum := sum + AAddNumber; end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
// Simple cases
|
|
||||||
if (Length(Args) < 1) then begin
|
|
||||||
AResult := IntegerResult(0);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if (Length(Args) < 2) then
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
|
|
||||||
if (ARangeIndex < 0) or (ARangeIndex >= Length(Args)) then
|
|
||||||
raise Exception.Create('[DoIF] Range index error.');
|
|
||||||
if (AConditionRangeIndex < 0) or (AConditionRangeIndex >= Length(Args)) then
|
|
||||||
raise Exception.Create('[DoIF] Condition range index error.');
|
|
||||||
if (AConditionIndex < 0) or (AConditionIndex >= Length(Args)) then
|
|
||||||
raise Exception.Create('[DoIF] Condition index error.');
|
|
||||||
|
|
||||||
// Get format settings for string-to-float or -to-datetime conversion
|
|
||||||
if (Args[AConditionRangeIndex].ResultType in [rtCell, rtCellRange]) then
|
|
||||||
fs := (Args[AConditionRangeIndex].Worksheet as TsWorksheet).FormatSettings
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
count := 0;
|
|
||||||
sum := 0.0;
|
|
||||||
|
|
||||||
// Iterate over all conditions
|
|
||||||
condIdx := AConditionIndex;
|
|
||||||
condRngIdx := AConditionRangeIndex;
|
|
||||||
while (condIdx < Length(Args)) and (condRngIdx < Length(Args)) do
|
|
||||||
begin
|
|
||||||
// Get compare operation and compare value
|
|
||||||
if (Args[condIdx].ResultType = rtCell) then
|
|
||||||
begin
|
|
||||||
cell := ArgToCell(Args[condIdx]);
|
|
||||||
if cell = nil then
|
|
||||||
comparetype := ctEmpty
|
|
||||||
else
|
|
||||||
case cell^.ContentType of
|
|
||||||
cctNumber:
|
|
||||||
begin
|
|
||||||
compareNumber := cell^.NumberValue;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end;
|
|
||||||
cctDateTime:
|
|
||||||
begin
|
|
||||||
compareNumber := cell^.DateTimevalue;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end;
|
|
||||||
cctBool:
|
|
||||||
begin
|
|
||||||
if cell^.BoolValue then compareNumber := 1.0 else compareNumber := 0.0;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end;
|
|
||||||
cctUTF8String:
|
|
||||||
begin
|
|
||||||
compareStr := UTF8Lowercase(cell^.UTF8StringValue);
|
|
||||||
compareType := ctString;
|
|
||||||
end;
|
|
||||||
cctEmpty:
|
|
||||||
begin
|
|
||||||
compareType := ctEmpty;
|
|
||||||
end;
|
|
||||||
cctError:
|
|
||||||
; // what to do here?
|
|
||||||
end;
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
s := ArgToString(Args[condIdx]);
|
|
||||||
if (Length(s) > 1) and (s[1] in ['=', '<', '>']) then
|
|
||||||
s := AnalyzeCompareStr(s, compareOp);
|
|
||||||
if s = '' then
|
|
||||||
compareType := ctEmpty
|
|
||||||
else
|
|
||||||
if TryStrToInt(s, n) then
|
|
||||||
begin
|
|
||||||
compareNumber := n;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end else
|
|
||||||
if TryStrToFloat(s, f, fs) then
|
|
||||||
begin
|
|
||||||
compareNumber := f;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end else
|
|
||||||
if TryStrToDate(s, dt, fs) or TryStrToTime(s, dt, fs) or TryStrToDateTime(s, dt, fs) then
|
|
||||||
begin
|
|
||||||
compareNumber := dt;
|
|
||||||
compareType := ctNumber;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
compareStr := UTF8Lowercase(s);
|
|
||||||
compareType := ctString;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Empty cells cannot be checked for <=, <, >, >= --> error
|
|
||||||
if (compareType = ctEmpty) and not (compareOp in [coEqual, coNotEqual]) then
|
|
||||||
begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Strings cannot be added --> error
|
|
||||||
if (AResultType > rtCount) and (compareType = ctString) and (Length(Args) = 2) then
|
|
||||||
begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// The sum of empty cells is be 0.
|
|
||||||
if (AResultType > rtCount) and (compareType = ctEmpty) and (Length(Args) = 2) then
|
|
||||||
begin
|
|
||||||
AResult := FloatResult(0.0);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Offsets to "add" range
|
|
||||||
if (Args[ARangeIndex].ResultType = rtCellRange) and (Args[condRngIdx].ResultType = rtCellRange) then
|
|
||||||
begin
|
|
||||||
dr := LongInt(Args[ARangeIndex].ResCellRange.Row1) - LongInt(Args[condRngIdx].ResCellRange.Row1);
|
|
||||||
dc := LongInt(Args[ARangeIndex].ResCellRange.Col1) - LongInt(Args[condRngIdx].ResCellRange.Col1);
|
|
||||||
end else
|
|
||||||
if (Args[ARangeIndex].ResultType = rtCell) and (Args[condRngIdx].ResultType = rtCell) then
|
|
||||||
begin
|
|
||||||
dr := LongInt(Args[ARangeIndex].ResRow) - LongInt(Args[condRngIdx].ResRow);
|
|
||||||
dc := LongInt(Args[ARangeIndex].ResCol) - LongInt(Args[condRngIdx].ResRow);
|
|
||||||
end else
|
|
||||||
begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Iterate through range
|
|
||||||
if (Args[0].ResultType = rtCell) then
|
|
||||||
case compareType of
|
|
||||||
ctNumber : DoCompareNumber(ArgToFloat(Args[condRngIdx]), ArgToFloat(Args[ArangeIndex]));
|
|
||||||
ctString : DoCompareString(ArgToString(Args[condRngIdx]), ArgToFloat(Args[ARangeIndex]));
|
|
||||||
ctEmpty : DoCompareEmpty(ArgToString(Args[condRngIdx]) = '', ArgToFloat(Args[ARangeIndex]));
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if (Args[condRngIdx].ResultType = rtCellRange) then begin
|
|
||||||
if Args[condRngIdx].ResCellRange.Sheet1 <> Args[condRngIdx].ResCellRange.Sheet2 then begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if (Args[ARangeIndex].ResCellRange.Sheet1 <> Args[ARangeIndex].ResCellrange.Sheet2) then
|
|
||||||
begin
|
|
||||||
AResult := ErrorResult(errArgError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
book := TsWorkbook(TsWorksheet(Args[condRngIdx].Worksheet).Workbook);
|
|
||||||
sheet0 := book.GetWorksheetByIndex(Args[condRngIdx].ResCellRange.Sheet1);
|
|
||||||
sheet2 := book.GetWorksheetbyIndex(Args[ARangeIndex].ResCellrange.Sheet1);
|
|
||||||
for r := Args[condRngIdx].ResCellRange.Row1 to Args[condRngIdx].ResCellRange.Row2 do
|
|
||||||
begin
|
|
||||||
for c := Args[condRngIdx].ResCellRange.Col1 to Args[condRngIdx].ResCellRange.Col2 do
|
|
||||||
begin
|
|
||||||
// Get value to be added for SUM and AVG. Not needed for counting (AResultType = rtCOUNT)
|
|
||||||
addnumber := 0;
|
|
||||||
if AResultType > rtCOUNT then
|
|
||||||
begin
|
|
||||||
addCell := sheet2.FindCell(r + dr, c + dc);
|
|
||||||
if addcell <> nil then
|
|
||||||
case addcell^.Contenttype of
|
|
||||||
cctNumber : addnumber := addcell^.NumberValue;
|
|
||||||
cctDateTime: addnumber := addcell^.DateTimeValue;
|
|
||||||
cctBool : if addcell^.BoolValue then addnumber := 1;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
cell := sheet0.FindCell(r, c);
|
|
||||||
case compareType of
|
|
||||||
ctNumber:
|
|
||||||
if cell <> nil then
|
|
||||||
begin
|
|
||||||
case cell^.ContentType of
|
|
||||||
cctNumber:
|
|
||||||
DoCompareNumber(cell^.NumberValue, addNumber);
|
|
||||||
cctDateTime:
|
|
||||||
DoCompareNumber(cell^.DateTimeValue, addNumber);
|
|
||||||
cctBool:
|
|
||||||
DoCompareNumber(IfThen(cell^.Boolvalue, 1, 0), addNumber);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
ctString:
|
|
||||||
if (cell <> nil) and (cell^.ContentType = cctUTF8String) then
|
|
||||||
DoCompareString(cell^.Utf8StringValue, addNumber);
|
|
||||||
ctEmpty:
|
|
||||||
DoCompareEmpty((cell = nil) or ((cell <> nil) and (cell^.ContentType = cctEmpty)), addNumber);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
inc(condIdx, 2);
|
|
||||||
inc(condRngIdx, 2);
|
|
||||||
end;
|
|
||||||
|
|
||||||
case AResultType of
|
|
||||||
rtCOUNT: AResult := IntegerResult(count);
|
|
||||||
rtSUM : AResult := FloatResult(sum);
|
|
||||||
rtAVG : if count > 0 then AResult := FloatResult(sum/count) else AResult := ErrorResult(errDivideByZero);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure fpsAVERAGEIF(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
procedure fpsAVERAGEIF(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
||||||
{ Calculates the average value of the cell values if they meet a given condition.
|
{ Calculates the average value of the cell values if they meet a given condition.
|
||||||
AVERAGEIF( range, condition, [ave_range] )
|
AVERAGEIF( range, condition, [ave_range] )
|
||||||
@ -2087,22 +1795,17 @@ procedure fpsAVERAGEIF(var AResult: TsExpressionresult; const Args: TsExprParame
|
|||||||
"range" are used.}
|
"range" are used.}
|
||||||
var
|
var
|
||||||
cmp: TsFuncComparer;
|
cmp: TsFuncComparer;
|
||||||
|
vr, cr, c: Integer;
|
||||||
begin
|
begin
|
||||||
if Length(Args) = 2 then
|
cr := 0; // (First) criteria range arg index
|
||||||
cmp := TsFuncComparer.Create(Args, 0, 0, 1, ftAVERAGEIF)
|
c := 1; // (First) criteria arg index.
|
||||||
else
|
if Length(Args) = 2 then vr := 0 else vr := 2; // value range arg index
|
||||||
cmp := TsFuncComparer.Create(Args, 2, 0, 1, ftAVERAGEIF);
|
cmp := TsFuncComparer.Create(Args, vr, cr, c, ftAVERAGEIF);
|
||||||
try
|
try
|
||||||
AResult := cmp.Execute;
|
AResult := cmp.Execute;
|
||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
{
|
|
||||||
if Length(Args) = 2 then
|
|
||||||
DoIF(AResult, Args, 0, 0, 1, rtAVG)
|
|
||||||
else
|
|
||||||
DoIF(AResult, Args, 2, 0, 1, rtAVG);
|
|
||||||
}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsAVERAGEIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
procedure fpsAVERAGEIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
||||||
@ -2122,7 +1825,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
// DoIF(AResult, Args, 0, 1, 2, rtAVG);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsCOUNTIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray);
|
procedure fpsCOUNTIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray);
|
||||||
@ -2140,7 +1842,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
//DoIF(AResult, Args, 0, 0, 1, rtCOUNT);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsCOUNTIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
procedure fpsCOUNTIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
||||||
@ -2160,7 +1861,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
//DoIF(AResult, Args, 0, 1, 2, rtCOUNT);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsSUMIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray);
|
procedure fpsSUMIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray);
|
||||||
@ -2175,8 +1875,8 @@ var
|
|||||||
cmp: TsFuncComparer;
|
cmp: TsFuncComparer;
|
||||||
vr, cr, c: Integer;
|
vr, cr, c: Integer;
|
||||||
begin
|
begin
|
||||||
cr := 0; // criteria range arg index
|
cr := 0; // First criteria range arg index
|
||||||
c := 1; // criteria arg index
|
c := 1; // First criteria arg index
|
||||||
if Length(Args) = 2 then
|
if Length(Args) = 2 then
|
||||||
vr := 0 // value range index
|
vr := 0 // value range index
|
||||||
else
|
else
|
||||||
@ -2187,12 +1887,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
{
|
|
||||||
if Length(Args) = 2 then
|
|
||||||
DoIF(AResult, Args, 0, 0, 1, rtSUM)
|
|
||||||
else
|
|
||||||
DoIF(AResult, Args, 2, 0, 1, rtSUM);
|
|
||||||
}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsSUMIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
procedure fpsSUMIFS(var AResult: TsExpressionresult; const Args: TsExprParameterArray);
|
||||||
@ -2212,7 +1906,6 @@ begin
|
|||||||
finally
|
finally
|
||||||
cmp.Free;
|
cmp.Free;
|
||||||
end;
|
end;
|
||||||
// DoIF(AResult, Args, 0, 1, 2, rtSUM);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure fpsMAX(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
procedure fpsMAX(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user