改進delphi中的RoundTo函數

    delphi 7中自帶數值四舍五入函數RoundTo(AVlaue, ADigit)存在一些不確定性情況，並非像幫助或者網絡說的四舍六入五湊偶的規則，不信可以隨便測試幾個數據就會發現與你預期的不一樣，比如33.015與33.035，修約2位小數，運行結果卻是33.01與33.03。這主要是與浮點數的精度有關（有興趣可以了解一下浮點數的存儲結構，我之前有轉載了一篇相關文章），我改進這個問題，較好的解決的前面的問題，同時執行速度較快，用法與RoundTo一樣，代碼如下：

function IsVeryNear1(f: double): boolean;
var    // 判斷給定實數的小數部分是否無限接近1，根據浮點數的存儲格式來判定
  f1: double;
  zs, i:integer;
  arr: array [1..8] of byte;
  pb: Pbyte;
  pfInt: Pint64;
  fInt, tmp1, tmp2:int64;
  p: Pointer;
begin
  p := @f;
  pb := Pbyte(p);
  for i := 1 to 8 do
  begin
    arr[9 - i] := pb^;
    inc(pb);
  end;
  zs := ((arr[1] and $7f) shl 4) + ((arr[2] and $F0) shr 4) - 1023; //浮點數的指數
  if zs < -1 then   // 小數部分前幾位全是零的情況
  begin
    result := false;
    Exit;
  end;
  pfInt := PInt64(p);
  fInt := pfInt^;
  fInt := ((fInt and $000fffffffffffff) or $0010000000000000);
  if (zs = -1) then
  begin
    if fInt = $001fffffffffffff then result := true
    else result := false;
  end
  else begin
    tmp1 := $000fffffffffffff;
    tmp2 := $001fffffffffffff;
    for i := 0 to zs do
    begin
      tmp2 := (tmp2 and tmp1);
      tmp1 := (tmp1 shr 1);
    end;
    if ((fInt and tmp2) = tmp2) then  result := true // 當小數部分全部為1時，理解為小數無限接近1
    else result := false;
  end;
end;
// 新的改進型四舍五入函數
function NewRoundTo(const AValue: double; const ADigit: TRoundToRange): Double;
var
  ef, f1, a2:  double;
  i, n: integer;
  a1, intV: int64;
  f_sign: boolean;
begin
  if AValue = 0 then begin
    Result := 0;
    Exit;
  end;
  if ADigit < 0 then // 修約小數點之后的小數位
  begin
    if AValue > 0 then f_sign := true  // 正數
    else f_sign := false;              // 負數
    a1 := 1;
    for i := 1 to (-ADigit) do a1 := a1 * 10;
    ef := abs(AValue * a1 * 10);
    intV := trunc(ef);
    if isVeryNear1(ef) then inc(intV);  // 這一步是關鍵
    n := (intV mod 10);
    if (n > 4) then  intV := intV - n + 10
    else intV := intV - n;
    if f_sign then  ef := intV/(a1*10)
    else ef := -1.0*intV/(a1*10);
    result := ef;
    exit;
  end;
  if ADigit = 0 then
  begin
    if frac(AValue) >= 0.5 then ef := trunc(AValue) + 1
    else ef := trunc(AValue);
    result := ef;
    exit;
  end;
  if ADigit > 0 then
  begin
    result := roundTo(AValue, ADigit);
    exit;
  end;
end;

這里還有另外一個他人寫的解決函數，但是執行速度比前面的函數慢了非常多，只針對小數進行了修約，如下：

function RoundFloat(f: double; i: integer): double;
var
  s: string;
  ef: Extended;
begin
  if f = 0 then begin
    Result := 0;
    Exit;
  end;
  s := '#.' + StringOfChar('0', i);
  if s = '#.' then s := '#';
  ef := StrToFloat(FloatToStr(f)); //防止浮點運算的誤差
  result := StrToFloat(FormatFloat(s, ef));
end;