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,