diff --git a/components/fpspreadsheet/fpsmath.pas b/components/fpspreadsheet/fpsmath.pas index dc5c932b4..1666c521f 100644 --- a/components/fpspreadsheet/fpsmath.pas +++ b/components/fpspreadsheet/fpsmath.pas @@ -8,7 +8,7 @@ uses Classes, SysUtils, fpspreadsheet; type - TsArgumentType = (atNumber, atString, atBool, atError); + TsArgumentType = (atNumber, atString, atBool, atError, atEmpty); TsArgument = record IsMissing: Boolean; @@ -41,6 +41,7 @@ function CreateBool(AValue: Boolean): TsArgument; function CreateNumber(AValue: Double): TsArgument; function CreateString(AValue: String): TsArgument; function CreateError(AError: TsErrorValue): TsArgument; +function CreateEmpty: TsArgument; { These are the functions called when calculating an RPN formula. @@ -63,8 +64,13 @@ function fpsGreaterEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsLess (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsLessEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsNotEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument; -function fpsAnd (Args: TsArgumentStack; NumArgs: Integer): TsArgument; -function fpsOr (Args: TsArgumentStack; NumArgs: Integer): TsArgument; + +function fpsAND (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsFALSE (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsIF (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsNOT (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsOR (Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsTRUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument; implementation @@ -253,68 +259,9 @@ begin Result.ErrorValue := AError; end; - -function Pop_1Bool(Args: TsArgumentStack; out a: Boolean): TsErrorValue; +function CreateEmpty: TsArgument; begin - Result := GetBoolFromArgument(Args.Pop, a); -end; - -function Pop_1Float(Args: TsArgumentStack; out a: Double): TsErrorValue; -begin - Result := GetNumberFromArgument(Args.Pop, a); -end; - -function Pop_1String(Args: TsArgumentStack; out a: String): TsErrorvalue; -begin - Result := GetStringFromArgument(Args.Pop, a); -end; - -function Pop_2Bools(Args: TsArgumentStack; out a, b: Boolean): TsErrorValue; -var - erra, errb: TsErrorValue; -begin - // Pop the data in reverse order they were pushed! Otherwise they will be - // applied to the function in the wrong order. - errb := GetBoolFromArgument(Args.Pop, b); - erra := GetBoolFromArgument(Args.Pop, a); - if erra <> errOK then - Result := erra - else if errb <> errOK then - Result := errb - else - Result := errOK; -end; - -function Pop_2Floats(Args: TsArgumentStack; out a, b: Double): TsErrorValue; -var - erra, errb: TsErrorValue; -begin - // Pop the data in reverse order they were pushed! Otherwise they will be - // applied to the function in the wrong order. - errb := GetNumberFromArgument(Args.Pop, b); - erra := GetNumberFromArgument(Args.Pop, a); - if erra <> errOK then - Result := erra - else if errb <> errOK then - Result := errb - else - Result := errOK; -end; - -function Pop_2Strings(Args: TsArgumentStack; out a, b: String): TsErrorValue; -var - erra, errb: TsErrorValue; -begin - // Pop the data in reverse order they were pushed! Otherwise they will be - // applied to the function in the wrong order. - errb := GetStringFromArgument(Args.Pop, b); - erra := GetStringFromArgument(Args.Pop, a); - if erra <> errOK then - Result := erra - else if errb <> errOK then - Result := errb - else - Result := errOK; + Result.ArgumentType := atEmpty; end; {@@ @@ -597,7 +544,7 @@ begin Result := CreateBool(false); end; -function fpsAnd(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsAND(Args: TsArgumentStack; NumArgs: Integer): TsArgument; var data: TBoolArray; i: Integer; @@ -615,7 +562,39 @@ begin end; end; -function fpsOr(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +function fpsFALSE(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +begin + Result := CreateBool(false); +end; + +function fpsIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +var + condition: TsArgument; + case1, case2: TsArgument; + err: TsErrorValue; +begin + if NumArgs = 3 then + case2 := Args.Pop; + case1 := Args.Pop; + condition := Args.Pop; + if condition.ArgumentType <> atBool then + Result := CreateError(errWrongType) + else + case NumArgs of + 2: if condition.BoolValue then Result := case1 else Result := Condition; + 3: if condition.BoolValue then Result := case1 else Result := case2; + end; +end; + +function fpsNOT(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +var + data: TBoolArray; +begin + if PopBoolValues(Args, NumArgs, data, Result) then + Result := CreateBool(not data[0]); +end; + +function fpsOR(Args: TsArgumentStack; NumArgs: Integer): TsArgument; var data: TBoolArray; i: Integer; @@ -633,4 +612,9 @@ begin end; end; +function fpsTRUE(Args: TsArgumentStack; NumArgs: Integer): TsArgument; +begin + Result := CreateBool(true); +end; + end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 8cd0bbd93..2f705d719 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -511,7 +511,8 @@ type out ACurrencySymbol: String): Boolean; { Writing of values } - procedure WriteBlank(ARow, ACol: Cardinal); + procedure WriteBlank(ARow, ACol: Cardinal); overload; + procedure WriteBlank(ACell: PCell); overload; procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); overload; procedure WriteBoolValue(ACell: PCell; AValue: Boolean); overload; @@ -1195,11 +1196,11 @@ const (Symbol:'RATE'; MinParams:3; MaxParams:6; Func:nil), // fekRATE { logical } (Symbol:'AND'; MinParams:0; MaxParams:30; Func:fpsAND), // fekAND - (Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:nil), // fekFALSE - (Symbol:'IF'; MinParams:2; MaxParams:3; Func:nil), // fekIF - (Symbol:'NOT'; MinParams:1; MaxParams:1; Func:nil), // fekNOT + (Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:fpsFALSE), // fekFALSE + (Symbol:'IF'; MinParams:2; MaxParams:3; Func:fpsIF), // fekIF + (Symbol:'NOT'; MinParams:1; MaxParams:1; Func:fpsNOT), // fekNOT (Symbol:'OR'; MinParams:1; MaxParams:30; Func:fpsOR), // fekOR - (Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:nil), // fekTRUE + (Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:fpsTRUE), // fekTRUE { string } (Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR (Symbol:'CODE'; MinParams:1; MaxParams:1; Func:nil), // fekCODE @@ -1469,7 +1470,7 @@ begin val := func(args, fe.ParamsNum); // Push valid result on stack, exit in case of error case val.ArgumentType of - atNumber, atString, atBool: + atNumber, atString, atBool, atEmpty: args.Push(val); atError: begin @@ -1485,6 +1486,7 @@ begin atNumber: WriteNumber(ACell, val.NumberValue); atBool : WriteBoolValue(ACell, val.BoolValue); atString: WriteUTF8Text(ACell, val.StringValue); + atEmpty : WriteBlank(ACell); end; end else // This case is a program error --> raise an exception @@ -2414,17 +2416,27 @@ end; @param ARow The row of the cell @param ACol The column of the cell - - Note: Empty cells are useful when, for example, a border line extends - along a range of cells including empty cells. + Note: Empty cells are useful when, for example, a border line extends + along a range of cells including empty cells. } procedure TsWorksheet.WriteBlank(ARow, ACol: Cardinal); -var - ACell: PCell; begin - ACell := GetCell(ARow, ACol); - ACell^.ContentType := cctEmpty; - ChangedCell(ARow, ACol); + WriteBlank(GetCell(ARow, ACol)); +end; + +{@@ + Writes as empty cell + + @param ACel Pointer to the cell + Note: Empty cells are useful when, for example, a border line extends + along a range of cells including empty cells. +} +procedure TsWorksheet.WriteBlank(ACell: PCell); +begin + if ACell <> nil then begin + ACell^.ContentType := cctEmpty; + ChangedCell(ACell^.Row, ACell^.Col); + end; end; {@@ diff --git a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc index c50147727..d5690456c 100644 --- a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc +++ b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc @@ -381,3 +381,112 @@ SetLength(sollValues, Row+1); sollValues[Row] := CreateBool(true or false or true); + // function =FALSE() + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=FALSE()'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNFunc(fekFALSE, nil))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateBool(false); + + // function =TRUE() + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=TRUE()'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNFunc(fekTRUE, nil))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateBool(true); + + // NOT + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=NOT(false)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(false, + RPNFunc(fekNOT, nil)))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateBool(not false); + + // IF (2 parameters)/strings/case true + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,"A")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(true, + RPNString('A', + RPNFunc(fekIF, 2, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateString('A'); + + // IF (2 parameters) /floats/case true + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(true, + RPNNumber(1.0, + RPNFunc(fekIF, 2, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(1); + + // IF (2 parameters)/strings/case falsee + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,"A")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(false, + RPNString('A', + RPNFunc(fekIF, 2, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateBool(false); + + // IF (2 parameters) /floats/case tfalse + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,1)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(false, + RPNNumber(1.0, + RPNFunc(fekIF, 2, nil))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateBool(false); + + // IF (3 parameters)/strings + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,"A","B")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(true, + RPNString('A', + RPNString('B', + RPNFunc(fekIF, 3, nil)))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateString('A'); + + // IF (3 parameters) /floats + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1,2)'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(true, + RPNNumber(1.0, + RPNNumber(2.0, + RPNFunc(fekIF,3, nil)))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(1); + + // IF (3 parameters) /floats / mixed types, case true + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1,"A")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(true, + RPNNumber(1.0, + RPNString('A', + RPNFunc(fekIF,3, nil)))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateNumber(1); + + // IF (3 parameters) /floats / mixed types, case false + inc(Row); + MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,1,"A")'); + MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula( + RPNBool(false, + RPNNumber(1.0, + RPNString('A', + RPNFunc(fekIF, 3, nil)))))); + SetLength(sollValues, Row+1); + sollValues[Row] := CreateString('A'); +