- Код: Выделить всё
function SimpleRoundTo(const AValue: Extended; const Digits: TRoundToRange = -2): Extended;
var
RV : Extended;
begin
RV := IntPower(10, -Digits);
if AValue < 0 then
Result := Trunc((AValue*RV) - 0.5)/RV
else
Result := Trunc((AValue*RV) + 0.5)/RV;
end;
\0
Но она не всегда работает как надо, например, для значения -2.235 функция округлит до -2.23.
Чтобы такого не происходило, нужно в нее добавить значение 1/MaxInt:
- Код: Выделить всё
function SimpleRoundTo(const AValue: Extended; const Digits: TRoundToRange = -2): Extended;
var
RV : Extended;
begin
RV := IntPower(10, -Digits);
if AValue < 0 then
Result := Trunc(((AValue-1/MaxInt)*RV) - 0.5)/RV
else
Result := Trunc(((AValue+1/MaxInt)*RV) + 0.5)/RV;
end;
\0
И тогда этот тест выполнится, как надо:
- Код: Выделить всё
procedure TTestCommon.TestRound;
const
CFLOAT: array[0..11] of Extended =
(0.5, 1.5, 2.45, 2.5, 2.55, 3.45, 3.5, 445.185, 38.025, 3.55, -2.564, -2.235);
CCUR: array[0..11] of Extended =
(0.5, 1.5, 2.45, 2.5, 2.55, 3.45, 3.5, 445.19, 38.03, 3.55, -2.56, -2.24);
var
i: Integer;
begin
for i := Low(CFLOAT) to High(CFLOAT) do
CheckEquals(CCUR[i], SimpleRoundTo(CFLOAT[i]));
end;
Эта функция уже проверена на вычислениях в течение 8 лет бухгалтерского учета и работает. Почему до сих пор в fpc, delphi нет подобной простой функции? Хотя, что я говорю, она конечно же есть, но дает неверные значения для некоторых аргументов и надо, надо, надо делать ПАТЧ. ПАТЧ! Конечно же ПАТЧ!
Но патч не примут, потому что MaxInt меньше, чем Extended и на граничных значениях Digits что-то снова не будет идти как надо. Почему в жизни так все сложно?!
