diff --git a/components/fpspreadsheet/source/common/fpsfunc.pas b/components/fpspreadsheet/source/common/fpsfunc.pas
index aab92421c..988777e0b 100644
--- a/components/fpspreadsheet/source/common/fpsfunc.pas
+++ b/components/fpspreadsheet/source/common/fpsfunc.pas
@@ -408,6 +408,15 @@ begin
Result := FloatResult(random);
end;
+// Avoids Banker's rounding
+function MyRoundTo(const AValue: Double; const Digits: TRoundToRange): Double;
+var
+ RV: Double;
+begin
+ RV := IntPower(10,Digits);
+ Result := fpsUtils.Round(AValue / RV) * RV;
+end;
+
procedure fpsROUND(var Result: TsExpressionResult; const Args: TsExprParameterArray);
var
x: TsExprFloat;
@@ -422,7 +431,7 @@ begin
if IsNaN(x) then
Result := ErrorResult(errWrongType)
else
- Result := FloatResult(RoundTo(x, -n));
+ Result := FloatResult(MyRoundTo(x, -n));
// -n because fpc and Excel have different conventions regarding the sign
end;
end;
diff --git a/components/fpspreadsheet/source/common/fpsnumformat.pas b/components/fpspreadsheet/source/common/fpsnumformat.pas
index 3f70b0872..6f4ab9583 100644
--- a/components/fpspreadsheet/source/common/fpsnumformat.pas
+++ b/components/fpspreadsheet/source/common/fpsnumformat.pas
@@ -859,8 +859,9 @@ begin
// No decimal separator --> format as integer
if i >= numEl then begin
- Result := ProcessIntegerFormat(IntToStr(round(AValue)), fs, AElements, AIndex,
- (INT_TOKENS + [nftIntTh]), false, useThSep);
+ // fpsUtils.Round() avoids Banker's rounding
+ Result := ProcessIntegerFormat(IntToStr(fpsUtils.Round(AValue)), fs,
+ AElements, AIndex, (INT_TOKENS + [nftIntTh]), false, useThSep);
exit;
end;
diff --git a/components/fpspreadsheet/source/common/fpsutils.pas b/components/fpspreadsheet/source/common/fpsutils.pas
index e63470a87..386b71ca6 100644
--- a/components/fpspreadsheet/source/common/fpsutils.pas
+++ b/components/fpspreadsheet/source/common/fpsutils.pas
@@ -153,6 +153,8 @@ function TryStrToFloatAuto(AText: String; out ANumber: Double;
function TryFractionStrToFloat(AText: String; out ANumber: Double;
out AIsMixed: Boolean; out AMaxDigits: Integer): Boolean;
+function Round(AValue: Double): Integer;
+
function cmToPts(AValue: Double): Double; inline;
function EMUToIn(AValue: Int64): Double; inline;
function EMUToMM(AValue: Int64): Double; inline;
@@ -1849,6 +1851,16 @@ begin
Result := true;
end;
+{@@ ----------------------------------------------------------------------------
+ Special rounding function which avoids banker's rounding
+-------------------------------------------------------------------------------}
+function Round(AValue: Double): Integer;
+begin
+ if AValue > 0 then
+ Result := trunc(AValue + 0.5)
+ else
+ Result := trunc(AValue - 0.5);
+end;
{@@ ----------------------------------------------------------------------------
Excel's unit of row heights is "twips", i.e. 1/20 point.
diff --git a/components/fpspreadsheet/tests/mathtests.pas b/components/fpspreadsheet/tests/mathtests.pas
new file mode 100644
index 000000000..b3bc5dc0e
--- /dev/null
+++ b/components/fpspreadsheet/tests/mathtests.pas
@@ -0,0 +1,87 @@
+{-------------------------------------------------------------------------------
+ Tests for some dedicated math routines which are specific to spreadsheets.
+-------------------------------------------------------------------------------}
+
+unit mathtests;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+ {$IFDEF Unix}
+ //required for formatsettings
+ clocale,
+ {$ENDIF}
+ // Not using Lazarus package as the user may be working with multiple versions
+ // Instead, add .. to unit search path
+ Classes, SysUtils, fpcunit, testutils, testregistry, testsutility,
+ fpstypes, fpspreadsheet, fpsutils;
+
+type
+ { TSpreadMathTests }
+ //Write to xls/xml file and read back
+ TSpreadMathTests = class(TTestCase)
+ private
+ protected
+ procedure TestRound(InputValue: Double; Expected: Integer);
+
+ published
+ // Test whether "round" avoids Banker's rounding
+ procedure TestRound_plus15;
+ procedure Testround_minus15;
+ procedure TestRound_plus25;
+ procedure TestRound_minus25;
+
+ end;
+
+implementation
+
+{ TSpreadMathTests }
+
+procedure TSpreadMathTests.TestRound(InputValue: Double; Expected: Integer);
+var
+ book: TsWorkbook;
+ sheet: TsWorksheet;
+ readValue: String;
+begin
+ book := TsWorkbook.Create;
+ try
+ sheet := book.AddWorksheet('Math');
+ sheet.WriteNumber(1, 1, InputValue, nfFixed, 0);
+ readValue := sheet.ReadAsText(1, 1);
+
+ CheckEquals(Expected, StrToInt(readValue),
+ 'Rounding error, sheet "' + sheet.Name + '"')
+ finally
+ book.Free;
+ end;
+end;
+
+procedure TSpreadMathTests.TestRound_plus15;
+begin
+ TestRound(1.5, 2);
+end;
+
+procedure TSpreadMathTests.TestRound_minus15;
+begin
+ Testround(-1.5, -2);
+end;
+
+procedure TSpreadMathTests.TestRound_plus25;
+begin
+ TestRound(2.5, 3);
+end;
+
+procedure TSpreadMathTests.Testround_minus25;
+begin
+ TestRound(-2.5, -3);
+end;
+
+
+initialization
+ RegisterTest(TSpreadMathTests);
+
+end.
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi
index 51cf94d25..dcbe51c60 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpi
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpi
@@ -40,7 +40,7 @@
-
+
@@ -167,6 +167,10 @@
+
+
+
+
diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr
index 7d80a979b..2982030f6 100644
--- a/components/fpspreadsheet/tests/spreadtestgui.lpr
+++ b/components/fpspreadsheet/tests/spreadtestgui.lpr
@@ -9,7 +9,7 @@ uses
SysUtils,
{$ENDIF}
Interfaces, Forms, GuiTestRunner, testsutility,
- datetests, stringtests, numberstests, manualtests, internaltests,
+ datetests, stringtests, numberstests, manualtests, internaltests, mathtests,
fileformattests, formattests, colortests, fonttests, optiontests,
numformatparsertests, formulatests, rpnFormulaUnit, singleformulatests,
exceltests, emptycelltests, errortests, virtualmodetests,