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