pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4675 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-02 17:18:20 +00:00
parent c1c54a5ee1
commit cd66ccd8a9
2 changed files with 149 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
components/fpspreadsheet/fpsnumformat.pas
View File

@ -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
if (AIndex < numEl) and (AElements[AIndex].Token = nftDecSep) then
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);
// Process the fractional part of the rounded number string
if p > 0 then begin
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;

114
components/fpspreadsheet/tests/numformatparsertests.pas
View File

@ -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);