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

fpspreadsheet: Extend compare functions (=, <, etc) to cell values (for calculation of formulas)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3283 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-04 22:11:34 +00:00
parent bab574b3b4
commit 827734cabe
2 changed files with 168 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
components/fpspreadsheet/fpsfunc.pas
View File

@ -60,6 +60,7 @@ function CreateNumberArg(AValue: Double): TsArgument;
function CreateStringArg(AValue: String): TsArgument;
function CreateErrorArg(AError: TsErrorValue): TsArgument;
function CreateEmptyArg: TsArgument;
function NoCellRangeArg(Arg: TsArgument): TsArgument;
{
These are the functions called when calculating an RPN formula.
@ -241,6 +242,14 @@ begin
Result.ArgumentType := atEmpty;
end;
function NoCellRangeArg(Arg: TsArgument): TsArgument;
begin
if Arg.ArgumentType = atCellRange then
Result := CreateCellArg(Arg.Worksheet.FindCell(Arg.FirstRow, Arg.FirstCol))
else
Result := Arg;
end;
{ Compares two arguments and returns -1 if "Arg2 > Arg1", +1 if "Arg1 < Arg2",
0 if "Arg1 = Arg2", MaxInt if result meaningless
If AExact is true only matching types are compared, otherwise types are converted before comparing. }
@ -1007,97 +1016,67 @@ end;
function fpsEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue = arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue = arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue = arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res = 0);
end;
function fpsGreater(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue > arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue > arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue > arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res > 0);
end;
function fpsGreaterEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue >= arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue >= arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue >= arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res >= 0);
end;
function fpsLess(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue < arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue < arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue < arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res < 0);
end;
function fpsLessEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue <= arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue <= arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue <= arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res <= 0);
end;
function fpsNotEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
arg1, arg2: TsArgument;
res: Integer;
begin
arg2 := Args.Pop;
arg1 := Args.Pop;
if arg1.ArgumentType = arg2.ArgumentType then
case arg1.ArgumentType of
atNumber : Result := CreateBoolArg(arg1.NumberValue <> arg2.NumberValue);
atString : Result := CreateBoolArg(arg1.StringValue <> arg2.StringValue);
atBool : Result := CreateBoolArg(arg1.Boolvalue <> arg2.BoolValue);
end
else
Result := CreateBoolArg(false);
arg2 := NoCellRangeArg(Args.Pop);
arg1 := NoCellRangeArg(Args.Pop);
res := CompareArgs(arg1, arg2, (arg1.ArgumentType <> atCell) and (arg2.ArgumentType <> atCell));
Result := CreateBoolArg(res <> 0);
end;

141
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -246,8 +246,7 @@
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNBool(false,
RPNParenthesis(
RPNFunc(fekEqual, nil))))));
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true = false);
@ -257,8 +256,7 @@
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNString('Hallo',
RPNString('world',
RPNParenthesis(
RPNFunc(fekEqual, nil))))));
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg('Hallo' = 'world');
@ -268,19 +266,45 @@
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(1.0,
RPNNumber(1.0,
RPNParenthesis(
RPNFunc(fekEqual, nil))))));
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1=1);
// Equal (cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M1=1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M1',
RPNNumber(1.0,
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M1 is "A"
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2=1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2=N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1, N2 is 2
// Greater (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(true>false)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNBool(false,
RPNParenthesis(
RPNFunc(fekGreater, nil))))));
RPNFunc(fekGreater, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true > false);
@ -290,8 +314,7 @@
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNString('Hallo',
RPNString('world',
RPNParenthesis(
RPNFunc(fekGreater, nil))))));
RPNFunc(fekGreater, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg('Hallo' > 'world');
@ -301,11 +324,29 @@
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(1.0,
RPNNumber(1.0,
RPNParenthesis(
RPNFunc(fekGreater, nil))))));
RPNFunc(fekGreater, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1>1);
// Greater (cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2>1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekGreater, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2>N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekGreater, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1, N2 is 2
// Greater equal (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(true>=false)');
@ -339,6 +380,25 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1>=1);
// Greater equal(cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2>=1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekGreaterEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2>=N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekGreaterEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1, N2 is 2
// Less (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(true<false)');
@ -372,6 +432,25 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1<1);
// Less (cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekLess, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekLess, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1, N2 is 2
// Less equal (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(true<=false)');
@ -405,6 +484,25 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1<=1);
// Less equal (cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<=1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekLessEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<=N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekLessEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1, N2 is 2
// Not equal (bool)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(true<>false)');
@ -438,6 +536,25 @@
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(1<>1);
// Not equal (cell)
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<>1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNNumber(1.0,
RPNFunc(fekNotEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(false); // M2 is 1
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=(M2<>N2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellValue('M2',
RPNCellValue('N2',
RPNFunc(fekNotEqual, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBoolArg(true); // M2 is 1, N2 is 2
{------------------------------------------------------------------------------}
{ Math }
{------------------------------------------------------------------------------}