改进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;