diff --git a/components/fpspreadsheet/fpsmath.pas b/components/fpspreadsheet/fpsmath.pas
index b110b477c..a13b5cdd0 100644
--- a/components/fpspreadsheet/fpsmath.pas
+++ b/components/fpspreadsheet/fpsmath.pas
@@ -9,7 +9,6 @@ uses
type
TsArgumentType = (atNumber, atString, atBool, atError);
- TsArgumentError = (aeOK, aeWrongType, aeDivideByZero, aeFuncNotDefined);
TsArgument = record
IsMissing: Boolean;
@@ -17,7 +16,7 @@ type
atNumber : (NumberValue: Double);
atString : (StringValue: String);
atBool : (BoolValue: Boolean);
- atError : (ErrorValue: TsArgumentError);
+ atError : (ErrorValue: TsErrorValue);
end;
PsArgument = ^TsArgument;
@@ -34,20 +33,37 @@ type
procedure Delete(AIndex: Integer);
end;
-procedure CheckMissingBool (var Arg: TsArgument; ABool: Boolean);
-procedure CheckMissingNumber(var Arg: TsArgument; ANumber: Double);
-procedure CheckMissingString(var Arg: TsArgument; AString: String);
+procedure FixMissingBool (var Arg: TsArgument; ABool: Boolean);
+procedure FixMissingNumber(var Arg: TsArgument; ANumber: Double);
+procedure FixMissingString(var Arg: TsArgument; AString: String);
+function CreateBool(AValue: Boolean): TsArgument;
+function CreateNumber(AValue: Double): TsArgument;
+function CreateString(AValue: String): TsArgument;
+function CreateError(AError: TsErrorValue): TsArgument;
+
+{
+These are the functions called when calculating an RPN formula.
+}
type
TsFormulaFunc = function(Args: TsArgumentStack): TsArgument;
-function fpsAdd(Args: TsArgumentStack): TsArgument;
-function fpsSub(Args: TsArgumentStack): TsArgument;
-function fpsMul(Args: TsArgumentStack): TsArgument;
-function fpsDiv(Args: TsArgumentStack): TsArgument;
+function fpsAdd (Args: TsArgumentStack): TsArgument;
+function fpsSub (Args: TsArgumentStack): TsArgument;
+function fpsMul (Args: TsArgumentStack): TsArgument;
+function fpsDiv (Args: TsArgumentStack): TsArgument;
+function fpsPercent(Args: TsArgumentStack): TsArgument;
+function fpsPower (Args: TsArgumentStack): TsArgument;
+function fpsUMinus (Args: TsArgumentStack): TsArgument;
+function fpsUPlus (Args: TsArgumentStack): TsArgument;
+function fpsConcat (Args: TsArgumentStack): TsArgument;
+function fpsEqual (Args: TsArgumentStack): TsArgument;
implementation
+uses
+ Math;
+
{ TsArgumentStack }
@@ -142,7 +158,7 @@ end;
@param Arg Argument to be considered
@param ABool Replacement for the missing value
}
-procedure CheckMissingBool(var Arg: TsArgument; ABool: Boolean);
+procedure FixMissingBool(var Arg: TsArgument; ABool: Boolean);
begin
if Arg.IsMissing then Arg.BoolValue := ABool;
end;
@@ -152,7 +168,7 @@ end;
@param Arg Argument to be considered
@param ANumber Replacement for the missing value
}
-procedure CheckMissingNumber(var Arg: TsArgument; ANumber: Double);
+procedure FixMissingNumber(var Arg: TsArgument; ANumber: Double);
begin
if Arg.IsMissing then Arg.NumberValue := ANumber;
end;
@@ -162,7 +178,7 @@ end;
@param Arg Argument to be considered
@param AString Replacement for the missing value
}
-procedure CheckMissingString(var Arg: TsArgument; AString: String);
+procedure FixMissingString(var Arg: TsArgument; AString: String);
begin
if Arg.IsMissing then Arg.StringValue := AString;
end;
@@ -170,95 +186,254 @@ end;
{ Preparing arguments }
-function GetNumberFromArgument(Arg: TsArgument; var ANumber: Double): TsArgumentError;
+function GetBoolFromArgument(Arg: TsArgument; var AValue: Boolean): TsErrorValue;
begin
- Result := aeOK;
+ case Arg.ArgumentType of
+ atBool : begin
+ AValue := Arg.BoolValue;
+ Result := errOK;
+ end;
+ else Result := errWrongType;
+ end;
+end;
+
+function GetNumberFromArgument(Arg: TsArgument; var ANumber: Double): TsErrorValue;
+begin
+ Result := errOK;
case Arg.ArgumentType of
atNumber : ANumber := Arg.NumberValue;
- atString : if not TryStrToFloat(arg.StringValue, ANumber) then Result := aeWrongType;
+ atString : if not TryStrToFloat(arg.StringValue, ANumber) then Result := errWrongType;
atBool : if Arg.BoolValue then ANumber := 1.0 else ANumber := 0.0;
end;
end;
+function GetStringFromArgument(Arg: TsArgument; var AString: String): TsErrorValue;
+begin
+ case Arg.ArgumentType of
+ atString : begin
+ AString := Arg.StringValue;
+ Result := errOK;
+ end;
+ else Result := errWrongType;
+ end;
+end;
+
+function CreateBool(AValue: Boolean): TsArgument;
+begin
+ Result.ArgumentType := atBool;
+ Result.Boolvalue := AValue;
+end;
+
function CreateNumber(AValue: Double): TsArgument;
begin
Result.ArgumentType := atNumber;
Result.NumberValue := AValue;
end;
+function CreateString(AValue: String): TsArgument;
+begin
+ Result.ArgumentType := atString;
+ Result.StringValue := AValue;
+end;
-function CreateError(AError: TsArgumentError): TsArgument;
+function CreateError(AError: TsErrorValue): TsArgument;
begin
Result.ArgumentType := atError;
Result.ErrorValue := AError;
end;
+function Pop_1Bool(Args: TsArgumentStack; out a: Boolean): TsErrorValue;
+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;
+end;
+
+
{ Operations }
function fpsAdd(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
- erra, errb: TsArgumentError;
+ err: TsErrorValue;
begin
- errb := GetNumberFromArgument(Args.Pop, b);
- erra := GetNumberFromArgument(Args.Pop, a);
- if erra <> aeOK then
- Result := CreateError(erra)
- else if errb <> aeOK then
- Result := CreateError(errb)
+ err := Pop_2Floats(Args, a, b);
+ if err = errOK then
+ Result := CreateNumber(a + b)
else
- Result := CreateNumber(a + b);
+ Result := CreateError(err);
end;
function fpsSub(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
- erra, errb: TsArgumentError;
+ err: TsErrorValue;
begin
- // Pop the data in reverse order they were pushed!
- errb := GetNumberFromArgument(Args.Pop, b);
- erra := GetNumberFromArgument(Args.Pop, a);
- if erra <> aeOK then
- Result := CreateError(erra)
- else if errb <> aeOK then
- Result := CreateError(errb)
+ err := Pop_2Floats(Args, a, b);
+ if err = errOK then
+ Result := CreateNumber(a - b)
else
- Result := CreateNumber(a - b);
+ Result := CreateError(err);
end;
function fpsMul(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
- erra, errb: TsArgumentError;
+ err: TsErrorValue;
begin
- errb := GetNumberFromArgument(Args.Pop, b);
- erra := GetNumberFromArgument(Args.Pop, a);
- if erra <> aeOK then
- Result := CreateError(erra)
- else if errb <> aeOK then
- Result := CreateError(errb)
+ err := Pop_2Floats(Args, a, b);
+ if err = errOK then
+ Result := CreateNumber(a * b)
else
- Result := CreateNumber(a * b);
+ Result := CreateError(err);
end;
function fpsDiv(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
- erra, errb: TsArgumentError;
+ err: TsErrorValue;
begin
- // Pop the data in reverse order they were pushed!
- errb := GetNumberFromArgument(Args.Pop, b);
- erra := GetNumberFromArgument(Args.Pop, a);
- if erra <> aeOK then
- Result := CreateError(erra)
- else if errb <> aeOK then
- Result := CreateError(errb)
+ err := Pop_2Floats(Args, a, b);
+ if err <> errOK then
+ Result := CreateError(err)
else if b = 0 then
- Result := CreateError(aeDivideByZero)
+ Result := CreateError(errDivideByZero)
else
Result := CreateNumber(a / b);
end;
+function fpsPercent(Args: TsArgumentStack): TsArgument;
+var
+ a: Double;
+ err: TsErrorValue;
+begin
+ err := Pop_1Float(Args, a);
+ if err = errOK then
+ Result := CreateNumber(a * 0.01)
+ else
+ Result := CreateError(err);
+end;
+
+function fpsPower(Args: TsArgumentStack): TsArgument;
+var
+ a, b: Double;
+ err: TsErrorValue;
+begin
+ err := Pop_2Floats(Args, a, b);
+ if err = errOK then begin
+ try
+ Result := CreateNumber(power(a, b));
+ except on E: EInvalidArgument do
+ Result := CreateError(errOverflow);
+ // this could happen, e.g., for "power( (neg value), (non-integer) )"
+ end;
+ end else
+ Result := CreateError(err);
+end;
+
+function fpsUMinus(Args: TsArgumentStack): TsArgument;
+var
+ a: Double;
+ err: TsErrorValue;
+begin
+ err := Pop_1Float(Args, a);
+ if err = errOK then
+ Result := CreateNumber(-a)
+ else
+ Result := CreateError(err);
+end;
+
+function fpsUPlus(Args: TsArgumentStack): TsArgument;
+var
+ a: Double;
+ err: TsErrorValue;
+begin
+ err := Pop_1Float(Args, a);
+ if err = errOK then
+ Result := CreateNumber(a)
+ else
+ Result := CreateError(err);
+end;
+
+function fpsConcat(Args: TsArgumentStack): TsArgument;
+var
+ a, b: String;
+ err: TsErrorValue;
+begin
+ err := Pop_2Strings(Args, a, b);
+ if err = errOK then
+ Result := CreateString(a + b)
+ else
+ Result := CreateError(err);
+end;
+
+function fpsEqual(Args: TsArgumentStack): TsArgument;
+var
+ a, b: Boolean;
+ err: TsErrorValue;
+begin
+ err := Pop_2Bools(Args, a, b);
+ if err = errOK then
+ Result := CreateBool(a = b)
+ else
+ Result := CreateError(err);
+end;
end.
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 0a07da188..738587dee 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -1093,32 +1093,32 @@ type
const
FEProps: array[TFEKind] of TFEProp = (
{ Operands }
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCell
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRef
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRange
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellNum
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellInteger
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellString
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellBool
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellErr
- (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellMissingArg
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCell
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRef
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRange
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellNum
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellInteger
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellString
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellBool
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellErr
+ (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellMissingArg
{ Basic operations }
- (Symbol:'+'; MinParams:2; MaxParams:2; Func:fpsAdd), // fekAdd
- (Symbol:'-'; MinParams:2; MaxParams:2; Func:fpsSub), // fekSub
- (Symbol:'*'; MinParams:2; MaxParams:2; Func:fpsMul), // fekMul
- (Symbol:'/'; MinParams:2; MaxParams:2; Func:fpsDiv), // fekDiv
- (Symbol:'%'; MinParams:1; MaxParams:1; Func:nil), // fekPercent
- (Symbol:'^'; MinParams:2; MaxParams:2; Func:nil), // fekPower
- (Symbol:'-'; MinParams:1; MaxParams:1; Func:nil), // fekUMinus
- (Symbol:'+'; MinParams:1; MaxParams:1; Func:nil), // fekUPlus
- (Symbol:'&'; MinParams:2; MaxParams:2; Func:nil), // fekConcat (string concatenation)
- (Symbol:'='; MinParams:2; MaxParams:2; Func:nil), // fekEqual
- (Symbol:'>'; MinParams:2; MaxParams:2; Func:nil), // fekGreater
- (Symbol:'>='; MinParams:2; MaxParams:2; Func:nil), // fekGreaterEqual
- (Symbol:'<'; MinParams:2; MaxParams:2; Func:nil), // fekLess
- (Symbol:'<='; MinParams:2; MaxParams:2; Func:nil), // fekLessEqual
- (Symbol:'<>'; MinParams:2; MaxParams:2; Func:nil), // fekNotEqual
- (Symbol:''; MinParams:1; MaxParams:1; Func:nil), // fekParen
+ (Symbol:'+'; MinParams:2; MaxParams:2; Func:fpsAdd), // fekAdd
+ (Symbol:'-'; MinParams:2; MaxParams:2; Func:fpsSub), // fekSub
+ (Symbol:'*'; MinParams:2; MaxParams:2; Func:fpsMul), // fekMul
+ (Symbol:'/'; MinParams:2; MaxParams:2; Func:fpsDiv), // fekDiv
+ (Symbol:'%'; MinParams:1; MaxParams:1; Func:fpsPercent), // fekPercent
+ (Symbol:'^'; MinParams:2; MaxParams:2; Func:fpsPower), // fekPower
+ (Symbol:'-'; MinParams:1; MaxParams:1; Func:fpsUMinus), // fekUMinus
+ (Symbol:'+'; MinParams:1; MaxParams:1; Func:fpsUPlus), // fekUPlus
+ (Symbol:'&'; MinParams:2; MaxParams:2; Func:fpsConcat), // fekConcat (string concatenation)
+ (Symbol:'='; MinParams:2; MaxParams:2; Func:nil), // fekEqual
+ (Symbol:'>'; MinParams:2; MaxParams:2; Func:nil), // fekGreater
+ (Symbol:'>='; MinParams:2; MaxParams:2; Func:nil), // fekGreaterEqual
+ (Symbol:'<'; MinParams:2; MaxParams:2; Func:nil), // fekLess
+ (Symbol:'<='; MinParams:2; MaxParams:2; Func:nil), // fekLessEqual
+ (Symbol:'<>'; MinParams:2; MaxParams:2; Func:nil), // fekNotEqual
+ (Symbol:''; MinParams:1; MaxParams:1; Func:nil), // fekParen
{ math }
(Symbol:'ABS'; MinParams:1; MaxParams:1; Func:nil), // fekABS
(Symbol:'ACOS'; MinParams:1; MaxParams:1; Func:nil), // fekACOS
@@ -1458,15 +1458,11 @@ begin
if not Assigned(func) then begin
// calculation of function not implemented
exit;
- end; {
- if args.Count < FEProps[fe.ElementKind].MinParams then begin
+ end;
+ if args.Count < fe.ParamsNum then begin
// not enough parameters
exit;
end;
- if args.Count > FEProps[fe.ElementKind].MaxParams then begin
- // too many parameters
- exit;
- end; }
// Result of function
val := func(args);
// Push valid result on stack, exit in case of error
@@ -1474,7 +1470,10 @@ begin
atNumber, atString, atBool:
args.Push(val);
atError:
- exit;
+ begin
+ WriteErrorValue(ACell, val.ErrorValue);
+ exit;
+ end;
end;
end; // case
end; // for
@@ -1485,8 +1484,18 @@ begin
atBool : WriteNumber(ACell, 1.0*ord(val.BoolValue));
atString: WriteUTF8Text(ACell, val.StringValue);
end;
+ {
+ case val.ArgumentType of
+ atNumber: ACell^.NumberValue := val.NumberValue; //WriteNumber(ACell, val.NumberValue);
+ atBool : ACell^.NumberValue := 1.0 * ord(val.BoolValue); //WriteNumber(ACell, 1.0*ord(val.BoolValue));
+ atString: ACell^.UTF8StringValue := val.StringValue; //(ACell, val.StringValue);
+ end;
+ }
end else
- WriteErrorValue(ACell, errArgError);
+ // This case is a program error --> raise an exception
+ raise Exception.CreateFmt('Incorrect argument count of the formula in cell %s', [
+ GetCellString(ACell^.Row, ACell^.Col, [])
+ ]);
finally
args.Free;
end;
@@ -5118,13 +5127,16 @@ end;
}
procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream);
begin
+ if Length(ACell^.RPNFormulaValue) > 0 then
+ WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell)
+ else
case ACell.ContentType of
- cctEmpty: WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
- cctDateTime: WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
- cctNumber: WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
- cctUTF8String: WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
- cctFormula: WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue, ACell);
- cctRPNFormula: WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell);
+ cctEmpty : WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
+ cctDateTime : WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
+ cctNumber : WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
+ cctUTF8String : WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
+ cctFormula : WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell^.FormulaValue, ACell);
+// cctRPNFormula: WriteRPNFormula(AStream, ACell^.Row, ACell^.Col, ACell^.RPNFormulaValue, ACell);
end;
end;
diff --git a/components/fpspreadsheet/tests/formulatests.pas b/components/fpspreadsheet/tests/formulatests.pas
index 74102ad9f..cba2da209 100644
--- a/components/fpspreadsheet/tests/formulatests.pas
+++ b/components/fpspreadsheet/tests/formulatests.pas
@@ -2,13 +2,19 @@ unit formulatests;
{$mode objfpc}{$H+}
+{ Deactivate this define in order to bypass tests which will raise an exception
+ when the corresponding rpn formula is calculated. }
+{.$DEFINE ENABLE_CALC_RPN_EXCEPTIONS}
+
+
interface
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry,
- fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
+ fpsallformats, fpspreadsheet, fpsmath,
+ xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
@@ -22,6 +28,8 @@ type
procedure TearDown; override;
// Test formula strings
procedure TestWriteReadFormulaStrings(AFormat: TsSpreadsheetFormat);
+ // Test calculation of rpn formulas
+ procedure TestCalcRPNFormulas(AFormat: TsSpreadsheetformat);
published
// Writes out numbers & reads back.
@@ -32,12 +40,16 @@ type
procedure TestWriteRead_BIFF5_FormulaStrings;
{ BIFF8 Tests }
procedure TestWriteRead_BIFF8_FormulaStrings;
+
+ // Writes out and calculates formulas, read back
+ { BIFF8 Tests }
+ procedure TestWriteRead_BIFF8_CalcRPNFormula;
end;
implementation
uses
- fpsUtils, rpnFormulaUnit;
+ math, typinfo, fpsUtils, rpnFormulaUnit;
{ TSpreadWriteReadFormatTests }
@@ -115,6 +127,96 @@ begin
TestWriteReadFormulaStrings(sfExcel8);
end;
+
+{ Test calculation of rpn formulas }
+
+procedure TSpreadWriteReadFormulaTests.TestCalcRPNFormulas(AFormat: TsSpreadsheetFormat);
+const
+ SHEET = 'Sheet1';
+var
+ MyWorksheet: TsWorksheet;
+ MyWorkbook: TsWorkbook;
+ Row: Integer;
+ TempFile: string; //write xls/xml to this file and read back from it
+ actual: TsArgument;
+ expected: TsArgument;
+ cell: PCell;
+ sollValues: array of TsArgument;
+ a, b: Double;
+begin
+ TempFile := GetTempFileName;
+
+ // Create test workbook
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkSheet:= MyWorkBook.AddWorksheet(SHEET);
+ MyWorkSheet.Options := MyWorkSheet.Options + [soCalcBeforeSaving];
+ // Calculation of rpn formulas must be activated expicitely!
+
+ { Write out test formulas.
+ This include file creates various rpn formulas and stores the expected
+ results in array "sollValues".
+ The test file contains the text representation in column A, and the
+ formula in column B. }
+ Row := 0;
+ {$I testcases_calcrpnformula.inc}
+
+ MyWorkBook.WriteToFile(TempFile, AFormat, true);
+ MyWorkbook.Free;
+
+ // Open the workbook
+ MyWorkbook := TsWorkbook.Create;
+ MyWorkbook.ReadFromFile(TempFile, AFormat);
+ if AFormat = sfExcel2 then
+ MyWorksheet := MyWorkbook.GetFirstWorksheet
+ else
+ MyWorksheet := GetWorksheetByName(MyWorkBook, SHEET);
+ if MyWorksheet=nil then
+ fail('Error in test code. Failed to get named worksheet');
+
+ for Row := 0 to MyWorksheet.GetLastRowIndex do begin
+ cell := MyWorksheet.FindCell(Row, 1);
+ if (cell = nil) then
+ fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
+ case cell^.ContentType of
+ cctBool : actual := CreateBool(cell^.NumberValue <> 0);
+ cctNumber : actual := CreateNumber(cell^.NumberValue);
+ cctError : actual := CreateError(cell^.ErrorValue);
+ cctUTF8String : actual := CreateString(cell^.UTF8StringValue);
+ else fail('ContentType not supported');
+ end;
+ expected := SollValues[row];
+ CheckEquals(ord(expected.ArgumentType), ord(actual.ArgumentType),
+ 'Test read calculated formula data type mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+ case actual.ArgumentType of
+ atBool:
+ CheckEquals(BoolToStr(expected.BoolValue), BoolToStr(actual.BoolValue),
+ 'Test read calculated formula result mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+ atNumber:
+ CheckEquals(expected.NumberValue, actual.NumberValue,
+ 'Test read calculated formula result mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+ atString:
+ CheckEquals(expected.StringValue, actual.StringValue,
+ 'Test read calculated formula result mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+ atError:
+ CheckEquals(
+ GetEnumName(TypeInfo(TsErrorValue), ord(expected.ErrorValue)),
+ GetEnumname(TypeInfo(TsErrorValue), ord(actual.ErrorValue)),
+ 'Test read calculated formula error value mismatch, cell '+CellNotation(MyWorkSheet,Row,1));
+ end;
+ end;
+
+ // Finalization
+ MyWorkbook.Free;
+ DeleteFile(TempFile);
+end;
+
+
+procedure TSpreadWriteReadFormulaTests.TestWriteRead_BIFF8_CalcRPNFormula;
+begin
+ TestCalcRPNFormulas(sfExcel8);
+end;
+
+
initialization
// Register so these tests are included in a full run
RegisterTest(TSpreadWriteReadFormulaTests);
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index a519b4425..ad3f18290 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -47,9 +47,6 @@
-
-
-
@@ -88,7 +85,6 @@
-
@@ -98,42 +94,34 @@
-
-
-
-
-
-
-
-
@@ -168,9 +156,6 @@
-
-
-
diff --git a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc
new file mode 100644
index 000000000..4c831919a
--- /dev/null
+++ b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc
@@ -0,0 +1,147 @@
+{ include file for "formulatests.pas", containing the test cases for the
+ calcrpnformula test. }
+
+ // Addition
+ Row := 0;
+ MyWorksheet.WriteUTF8Text(Row, 0, '=1+1');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(1.0,
+ RPNNumber(1.0,
+ RPNFunc(fekAdd, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(1.0+1.0);
+
+ // Subtraction
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=1-10');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(1,
+ RPNNumber(10,
+ RPNFunc(fekSub, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(1-10);
+
+ // Multiplication
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=10*-3');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(10,
+ RPNNumber(-3,
+ RPNFunc(fekMul, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(10*(-3));
+
+ // Multiplication w/Parenthesis
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=10*(-3)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(10,
+ RPNNumber(-3,
+ RPNParenthesis(
+ RPNFunc(fekMul, nil))))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(10*(-3));
+
+ // Division
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=10/200');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(10,
+ RPNNumber(200,
+ RPNFunc(fekDiv, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(10/200);
+
+ // Division: Error case - divide by zero
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=10/0');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(10,
+ RPNNumber(0,
+ RPNFunc(fekDiv, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateError(errDivideByZero);
+
+ // Percentage
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=10%');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(10,
+ RPNFunc(fekPercent, nil))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(10*0.01);
+
+ // Power
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=power(2.0, 0.5)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(2.0,
+ RPNNumber(0.5,
+ RPNFunc(fekPower, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(power(2, 0.5));
+
+{$IFDEF ENABLE_CALC_RPN_EXCEPTIONS}
+ // Power: Error case "power( (negative number), (fractional number) )"
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=power(-2.0, 0.5)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(-2.0,
+ RPNNumber(0.5,
+ RPNFunc(fekPower, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateError(errOverflow);
+{$ENDIF}
+
+ // Unary minus
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=-(-1)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(-1,
+ RPNParenthesis(
+ RPNFunc(fekUMinus, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(1);
+
+ // Unary plus
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=+(-1)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(-1,
+ RPNParenthesis(
+ RPNFunc(fekUPlus, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateNumber(-1);
+
+ // String concatenation
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '="Hallo"&" world"');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNString('Hallo',
+ RPNString(' world',
+ RPNFunc(fekConcat, nil)))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateString('Hallo' + ' world');
+(*
+ // Equal (strings)
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo"="world")');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNString('Hallo',
+ RPNString('world',
+ RPNParenthesis(
+ RPNFunc(fekConcat, nil))))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateBool('Hallo' = 'world');
+
+ // Equal (numbers)
+ inc(Row);
+ MyWorksheet.WriteUTF8Text(Row, 0, '=(1=1)');
+ MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+ RPNNumber(1.0,
+ RPNNumber(1.0,
+ RPNParenthesis(
+ RPNFunc(fekEqual, nil))))));
+ SetLength(sollValues, Row+1);
+ sollValues[Row] := CreateBool(1=1);
+ *)
diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas
index 48f9b065e..3bc242c6e 100755
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@@ -125,6 +125,7 @@ type
const AValue: string; ACell: PCell); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsRPNFormula; ACell: PCell); override;
+ procedure WriteStringRecord(AStream: TStream; AString: string);
procedure WriteStyle(AStream: TStream);
procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet);
procedure WriteXF(AStream: TStream; AFontIndex: Word;
@@ -798,6 +799,7 @@ procedure TsSpreadBIFF8Writer.WriteRPNFormula(AStream: TStream; const ARow,
ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
FormulaResult: double;
+ FormulaResultWords: array[0..3] of word absolute FormulaResult;
i: Integer;
len: Integer;
RPNLength: Word;
@@ -809,6 +811,38 @@ var
begin
RPNLength := 0;
FormulaResult := 0.0;
+ case ACell^.ContentType of
+ cctNumber:
+ FormulaResult := ACell^.NumberValue;
+ cctDateTime:
+ FormulaResult := ACell^.DateTimeValue;
+ cctUTF8String:
+ begin
+ if ACell^.UTF8StringValue = '' then
+ FormulaResultWords[0] := 3;
+ FormulaResultWords[3] := $FFFF;
+ end;
+ cctBool:
+ begin
+ FormulaResultWords[0] := 1;
+ FormulaResultWords[1] := word(ACell^.NumberValue <> 0);
+ FormulaResultWords[3] := $FFFF;
+ end;
+ cctError:
+ begin
+ FormulaResultWords[0] := 2;
+ case ACell^.ErrorValue of
+ errEmptyIntersection: FormulaResultWords[1] := ERR_INTERSECTION_EMPTY;// #NULL!
+ errDivideByZero : FormulaResultWords[1] := ERR_DIVIDE_BY_ZERO; // #DIV/0!
+ errWrongType : FormulaResultWords[1] := ERR_WRONG_TYPE_OF_OPERAND; // #VALUE!
+ errIllegalRef : FormulaResultWords[1] := ERR_ILLEGAL_REFERENCE; // #REF!
+ errWrongName : FormulaResultWords[1] := ERR_WRONG_NAME; // #NAME?
+ errOverflow : FormulaResultWords[1] := ERR_OVERFLOW; // #NUM!
+ errArgError : FormulaResultWords[1] := ERR_ARG_ERROR; // #N/A;
+ end;
+ FormulaResultWords[3] := $FFFF;
+ end;
+ end;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
@@ -950,6 +984,31 @@ begin
AStream.Position := RecordSizePos;
AStream.WriteWord(WordToLE(22 + RPNLength));
AStream.position := FinalPos;
+
+ { Write following STRING record if formula result is a non-empty string }
+ if (ACell^.ContentType = cctUTF8String) and (ACell^.UTF8StringValue <> '') then
+ WriteStringRecord(AStream, ACell^.UTF8StringValue);
+end;
+
+procedure TsSpreadBIFF8Writer.WriteStringRecord(AStream: TStream;
+ AString: String);
+var
+ wideStr: widestring;
+ len: Integer;
+begin
+ wideStr := AString;
+ len := Length(wideStr);
+
+ { BIFF Record header }
+ AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING));
+ AStream.WriteWord(WordToLE(3 + len*SizeOf(widechar)));
+
+ { Write widestring length }
+ AStream.WriteWord(WordToLE(len));
+ { Widestring flags, 1=regular unicode LE string }
+ AStream.WriteByte(1);
+ { Write characters }
+ AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar));
end;
{*******************************************************************
diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index 5d77e0da6..b81468d8f 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -37,7 +37,7 @@ const
INT_EXCEL_ID_BLANK = $0201; // BIFF2: $0001
INT_EXCEL_ID_NUMBER = $0203; // BIFF2: $0003
INT_EXCEL_ID_LABEL = $0204; // BIFF2: $0004
- INT_EXCEL_ID_STRING = $0207; // BIFF2: $0007;
+ INT_EXCEL_ID_STRING = $0207; // BIFF2: $0007
INT_EXCEL_ID_ROW = $0208; // BIFF2: $0008
INT_EXCEL_ID_INDEX = $020B; // BIFF2: $000B
INT_EXCEL_ID_WINDOW2 = $023E; // BIFF2: $003E