Delphi has a rounding function that uses bankers' rounding instead of mathematical rounding, which can cause issues in mathematical applications. Throughout the years, folks have used numerous solutions, frequently rewriting the round function to use mathematical rounding, or else adding both a bankers rounding function and a mathematical rounding function to allow for both methods. These have typically been only a few lines long.
Paul M. was upgrading some legacy code when he happened upon a unique solution to "fix" the Delphi rounding issue:
function MyRound(Value: extended; Decimals: integer = 2; const Mathematically: boolean = true): double; var s, s1, s2, sx: string; p, Round_Up, Zusatz, i: integer; function Getdecimals: string; var res, j: integer; begin res := length(s2); for j := length(s2) downto 1 do if s2[j] <> '0' then begin res := j; break; end; if Mathematically then Result := copy(s2, 1, res) else Result := copy(s2, 1, 3); //kaufmännisches Runden end; var z: integer; AllowToRound: boolean; begin s := floattostrf(Value, ffFixed, 18, 18); p := pos(DecimalSeparator, s) - 1; 2 Round_Up := 0; Zusatz := 0; if p > 0 then begin s1 := copy(s, 1, p); s2 := copy(s, p + 2, length(s) - p); s2 := Getdecimals; if Decimals >= length(s2) then begin Result := Value; exit; end; z := Decimals; if Decimals <> 0 then z := decimals - 1; AllowtoRound := Decimals = 0; if (strtoint(s2[1]) >= 5) and (Decimals = 0) then Round_Up := 1 else begin Zusatz := 0; i := length(s2); while true do begin if strtoint(s2[i]) + Zusatz >= 5 then begin if i > 1 then sx := inttostr(strtoint(s2[i - 1]) + 1); if strtoint(sx) >= 10 then begin if i > 1 then s2[i - 1] := '0'; Zusatz := 10; end else begin Zusatz := 0; if i > 1 then s2[i - 1] := sx[1]; end; end; dec(i); if i < 1 then begin AllowToRound := true; 3 break; end else begin if (i < (2 + z)) and (Zusatz = 0) then break; end; end; end; if AllowToRound and (strtoint(s2[1]) + Zusatz >= 5) then Round_Up := 1; end; if (Decimals = 0) or (Round_Up = 1) then begin if strtofloat(copy(s, 1, p)) < 0 then Round_up := -Round_up; Result := strtofloat(copy(s, 1, p)) + Round_up; end //Result:=trunc(Value)+Round_up : trunc funktioniert nicht, wenn ein Nicht-extended-Werte-typ übergeben wird, z.B. Myround(10/1000*1000, ...) //folgendes funktioniert aber : var x:extended; x:=10/1000*1000; Myround(x,...), else Result := strtofloat(s1 + DecimalSeparator + (copy(s2, 1, Decimals))); end;
For those who want to know how it should have been written, the main function is re-written below:
function MyRound(Value: extended; Decimals: integer = 2; const Mathematically: boolean = true): double; begin if Mathematically then begin if Value < 0 then Result := Trunc((Value * power(10, Decimals)) - 0.5) / power(10, Decimals) else Result := Trunc((Value * power(10, Decimals)) + 0.5) / power(10, Decimals); end else Result := Round(Value * power(10, Decimals)) / power(10, Decimals); end;