fpspreadsheet: Fix rounding error when number format is applied (issue #0030223)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4675 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsnumformat.pas

@@ -719,38 +719,53 @@ end;
 function ProcessFloatFormat(AValue: Double; AFormatSettings: TFormatSettings;
   const AElements: TsNumFormatElements; var AIndex: Integer): String;
 var
-  fs: TFormatSettings absolute AFormatSettings;
+  fs: TFormatSettings absolute AFormatSettings; // just to ease typing...
   numEl: Integer;
   numStr, s: String;
   p, i: Integer;
   decs: Integer;
   useThSep: Boolean;
+  decsIndex: Integer;
 begin
   Result := '';
   numEl := Length(AElements);
-
-  // Extract integer part
-  Result := IntToStr(trunc(AValue));
   useThSep := AElements[AIndex].Token = nftIntTh;
-  Result := ProcessIntegerFormat(Result, fs, AElements, AIndex,
+
+  // Find the element index of the decimal separator
+  i := AIndex;
+  while (i < numEl) and (AElements[i].Token <> nftDecSep) do
+    inc(i);
+
+  // No decimal separator --> format as integer
+  if i >= numEl then begin
+    Result := ProcessIntegerFormat(IntToStr(round(AValue)), fs, AElements, AIndex,
+      (INT_TOKENS + [nftIntTh]), false, useThSep);
+    exit;
+  end;
+
+  // There is a decimal separator. Get the count of decimal places.
+  decs := 0;
+  inc(i);
+  decsIndex := i;
+  while (i < numEl) and (AElements[i].Token in DECS_TOKENS) do begin
+    inc(decs, AElements[i].IntValue);
+    inc(i);
+  end;
+
+  // Convert value to string; this will do some rounding if required.
+  numstr := FloatToStrF(AValue, ffFixed, MaxInt, decs, fs);
+
+  // Process the integer part of the rounded number string
+  p := pos(fs.DecimalSeparator, numstr);
+  if p > 0 then s := copy(numstr, 1, p-1) else s := numstr;
+  Result := ProcessIntegerFormat(s, fs, AElements, AIndex,
     (INT_TOKENS + [nftIntTh]), false, UseThSep);
 
-  // Decimals
+  // Process the fractional part of the rounded number string
-  if (AIndex < numEl) and (AElements[AIndex].Token = nftDecSep) then
+  if p > 0 then begin
-  begin
-    inc(AIndex);
-    i := AIndex;
-    // Count decimal digits in format elements
-    decs := 0;
-    while (AIndex < numEl) and (AElements[AIndex].Token in DECS_TOKENS) do begin
-      inc(decs, AElements[AIndex].IntValue);
-      inc(AIndex);
-    end;
-    // Convert value to string
-    numstr := FloatToStrF(AValue, ffFixed, MaxInt, decs, fs);
-    p := Pos(fs.DecimalSeparator, numstr);
     s := Copy(numstr, p+1, Length(numstr));
-    s := ProcessIntegerFormat(s, fs, AElements, i, DECS_TOKENS, true, false);
+    AIndex := decsIndex;
+    s := ProcessIntegerFormat(s, fs, AElements, AIndex, DECS_TOKENS, true, false);
     if s <> '' then
       Result := Result + fs.DecimalSeparator + s;
   end;

components/fpspreadsheet/tests/numformatparsertests.pas

@@ -26,9 +26,93 @@ type
     SollSection2Color: TsColor;
   end;
 
+  TRoundingTestData = record
+    FormatString: String;
+    Number: Double;
+    SollString: String;
+  end;
+
 var
   ParserTestData: Array[0..13] of TParserTestData;
 
+  RoundingTestData: Array[0..62] of TRoundingTestData = (
+    // 0
+    (FormatString: '0'; Number:     1.2; SollString: '1'),
+    (FormatString: '0'; Number:     1.9; SollString: '2'),
+    (FormatString: '0'; Number:    -1.2; SollString: '-1'),
+    (FormatString: '0'; Number:    -1.9; SollString: '-2'),
+    (FormatString: '0'; Number:  1234.2; SollString: '1234'),
+    (FormatString: '0'; Number:  1234.9; SollString: '1235'),
+    (FormatString: '0'; Number: -1234.2; SollString: '-1234'),
+    (FormatString: '0'; Number: -1234.9; SollString: '-1235'),
+
+    // 8
+    (FormatString: '0.00'; Number:     1.2; SollString: '1.20'),
+    (FormatString: '0.00'; Number:     1.9; SollString: '1.90'),
+    (FormatString: '0.00'; Number:    -1.2; SollString: '-1.20'),
+    (FormatString: '0.00'; Number:    -1.9; SollString: '-1.90'),
+    (FormatString: '0.00'; Number:  1234.2; SollString: '1234.20'),
+    (FormatString: '0.00'; Number:  1234.9; SollString: '1234.90'),
+    (FormatString: '0.00'; Number: -1234.2; SollString: '-1234.20'),
+    (FormatString: '0.00'; Number: -1234.9; SollString: '-1234.90'),
+    (FormatString: '0.00'; Number:  1234.21; SollString: '1234.21'),
+    (FormatString: '0.00'; Number:  1234.99; SollString: '1234.99'),
+    (FormatString: '0.00'; Number: -1234.21; SollString: '-1234.21'),
+    (FormatString: '0.00'; Number: -1234.99; SollString: '-1234.99'),
+    (FormatString: '0.00'; Number:  1234.2123; SollString: '1234.21'),
+    (FormatString: '0.00'; Number:  1234.2999; SollString: '1234.30'),
+    (FormatString: '0.00'; Number:  1234.9123; SollString: '1234.91'),
+    (FormatString: '0.00'; Number:  1234.9993; SollString: '1235.00'),
+    (FormatString: '0.00'; Number: -1234.2123; SollString: '-1234.21'),
+    (FormatString: '0.00'; Number: -1234.2999; SollString: '-1234.30'),
+    (FormatString: '0.00'; Number: -1234.9123; SollString: '-1234.91'),
+    (FormatString: '0.00'; Number: -1234.9993; SollString: '-1235.00'),
+
+    // 28
+    (FormatString: '#,##0.00'; Number:     1.2; SollString: '1.20'),
+    (FormatString: '#,##0.00'; Number:     1.9; SollString: '1.90'),
+    (FormatString: '#,##0.00'; Number:    -1.2; SollString: '-1.20'),
+    (FormatString: '#,##0.00'; Number:    -1.9; SollString: '-1.90'),
+    (FormatString: '#,##0.00'; Number:  1234.2; SollString: '1,234.20'),
+    (FormatString: '#,##0.00'; Number:  1234.9; SollString: '1,234.90'),
+    (FormatString: '#,##0.00'; Number: -1234.2; SollString: '-1,234.20'),
+    (FormatString: '#,##0.00'; Number: -1234.9; SollString: '-1,234.90'),
+    (FormatString: '#,##0.00'; Number:  1234.2123; SollString: '1,234.21'),
+    (FormatString: '#,##0.00'; Number:  1234.2999; SollString: '1,234.30'),
+    (FormatString: '#,##0.00'; Number:  1234.9123; SollString: '1,234.91'),
+    (FormatString: '#,##0.00'; Number:  1234.9993; SollString: '1,235.00'),
+    (FormatString: '#,##0.00'; Number: -1234.2123; SollString: '-1,234.21'),
+    (FormatString: '#,##0.00'; Number: -1234.2999; SollString: '-1,234.30'),
+    (FormatString: '#,##0.00'; Number: -1234.9123; SollString: '-1,234.91'),
+    (FormatString: '#,##0.00'; Number: -1234.9993; SollString: '-1,235.00'),
+
+    // 44
+    (FormatString: '00.00'; Number:     1.2; SollString: '01.20'),
+    (FormatString: '00.00'; Number:     1.9; SollString: '01.90'),
+    (FormatString: '00.00'; Number:    -1.2; SollString: '-01.20'),
+    (FormatString: '00.00'; Number:    -1.9; SollString: '-01.90'),
+    (FormatString: '00.00'; Number:  1234.2; SollString: '1234.20'),
+    (FormatString: '00.00'; Number:  1234.9; SollString: '1234.90'),
+    (FormatString: '00.00'; Number: -1234.2; SollString: '-1234.20'),
+    (FormatString: '00.00'; Number: -1234.9; SollString: '-1234.90'),
+
+    // 52
+    (FormatString: '#.00'; Number:     0.2; SollString: '.20'),
+    (FormatString: '#.00'; Number:     0.9; SollString: '.90'),
+    (FormatString: '#.00'; Number:    -0.2; SollString: '-.20'),
+    (FormatString: '#.00'; Number:    -0.9; SollString: '-.90'),
+    (FormatString: '#.00'; Number:     1.2; SollString: '1.20'),
+    (FormatString: '#.00'; Number:    -1.9; SollString: '-1.90'),
+
+    // 58
+    (FormatString: '0.0##'; Number:     1.2; SollString: '1.2'),
+    (FormatString: '0.0##'; Number:     1.21; SollString: '1.21'),
+    (FormatString: '0.0##'; Number:     1.212; SollString: '1.212'),
+    (FormatString: '0.0##'; Number:     1.2134; SollString: '1.213'),
+    (FormatString: '0.0##'; Number:     1.2135; SollString: '1.214')
+
+  );
+
 procedure InitParserTestData;
 
 type
@@ -42,6 +126,7 @@ type
     // One cell per test so some tests can fail and those further below may still work
   published
     procedure TestNumFormatParser;
+    procedure TestRounding;
   end;
 
 
@@ -291,6 +376,35 @@ begin
   end;
 end;
 
+procedure TSpreadNumFormatParserTests.TestRounding;
+var
+  i: Integer;
+  parser: TsNumFormatParser;
+  MyWorkbook: TsWorkbook;
+  MyWorksheet: TsWorksheet;
+  actual: String;
+  fs: TFormatSettings;
+begin
+  MyWorkbook := TsWorkbook.Create;
+  try
+    fs := DefaultFormatSettings;
+    fs.DecimalSeparator := '.';
+    fs.ThousandSeparator := ',';
+    MyWorkbook.FormatSettings := fs;
+    MyWorksheet := MyWorkbook.AddWorksheet('Test');
+    for i:=0 to High(RoundingTestData) do begin
+      MyWorksheet.WriteNumber(0, 0,
+        RoundingTestData[i].Number, nfCustom, RoundingTestData[i].FormatString);
+      actual := MyWorksheet.ReadAsText(0, 0);
+      CheckEquals(RoundingTestData[i].SollString, actual,
+        'Rounding mismatch in test #' + IntToStr(i));
+    end;
+  finally
+    MyWorkbook.Free;
+  end;
+end;
+
+
 initialization
   // Register so these tests are included in a full run
   RegisterTest(TSpreadNumFormatParserTests);