feat(stdlib): configurable rounding for TMoney
TMoney previously hard-wired banker's rounding (rmHalfEven) at its single
normalisation point. The underlying TDecimal already supports all eight
TRoundingMode values plus custom IRoundingStrategy, so expose that through
TMoney: every constructor and rounding-sensitive operation gains overloads
taking an explicit TRoundingMode or an IRoundingStrategy.
MoneyFromStr('1.005','USD') -> 1.00 (banker's, unchanged default)
MoneyFromStr('1.005','USD', rmHalfUp) -> 1.01
C := A.Add(B, rmCeiling);
M := MoneyFromStr('9.999','USD', myCashRoundingStrategy);
Overloaded: MoneyFromStr, MoneyFromDecimal, Add, Subtract, Multiply (each
gains a TRoundingMode form and an IRoundingStrategy form). MoneyFromInt,
MoneyZero, MultiplyInt and Negate are exact (no fraction introduced) and
need no mode. The existing no-mode calls are unchanged and keep banker's
rounding, so this is fully backward-compatible.
Internally a single MakeMoneyS(strategy) core does the normalisation; the
mode form delegates via StandardRounding(Mode) and the default via
rmHalfEven — one rounding code path.
Tests: 5 IR/semantic tests and 8 dual-backend e2e tests covering the mode
overloads (HalfUp/Down/Ceiling), the custom-strategy overload, the
default-stays-banker's guarantee, and rounding on Add/Multiply/constructors.
Docs: language-rationale.adoc updated to record that rounding is swappable
per call (default banker's), not hard-wired.
Verified: FIXPOINT_OK, NATIVE_FIXPOINT_OK, NATIVE_INTERNAL_OK; full suite
green on both the QBE-built and native-built runners (3686 tests).
This commit is contained in:
parent
77aa15a8d8
commit
008cc12785
|
|
@ -64,6 +64,16 @@ type
|
|||
procedure TestRun_Equals_DifferentCurrency_False;
|
||||
procedure TestRun_IsZero_And_Sign;
|
||||
|
||||
{ --- Configurable rounding (mode + custom strategy overloads) --- }
|
||||
procedure TestRun_FromStr_RoundingMode_HalfUp;
|
||||
procedure TestRun_FromStr_RoundingMode_Down;
|
||||
procedure TestRun_FromStr_RoundingMode_Ceiling;
|
||||
procedure TestRun_FromDecimal_RoundingMode;
|
||||
procedure TestRun_Add_RoundingMode;
|
||||
procedure TestRun_Multiply_RoundingMode_Ceiling;
|
||||
procedure TestRun_FromStr_CustomStrategy_Truncates;
|
||||
procedure TestRun_DefaultIsBankers;
|
||||
|
||||
{ --- Registry --- }
|
||||
procedure TestRun_CurrencyScale_Registry;
|
||||
|
||||
|
|
@ -460,6 +470,153 @@ begin
|
|||
AssertEquals('True -1 1', 'True -1 1', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Configurable rounding }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_HalfUp;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ rmHalfUp rounds the 1.005 tie up, unlike the banker's default (1.00). }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money;
|
||||
begin WriteLn(MoneyFromStr('1.005', 'USD', rmHalfUp).AmountString()) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('1.005 halfUp -> 1.01', '1.01', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_Down;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ rmDown truncates toward zero: 1.999 -> 1.99. }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money;
|
||||
begin WriteLn(MoneyFromStr('1.999', 'USD', rmDown).AmountString()) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('1.999 down -> 1.99', '1.99', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_Ceiling;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ rmCeiling rounds toward +infinity: 1.991 -> 1.99? no — 1.991 -> 2.00 only at
|
||||
scale 0; at scale 2 the third digit 1 rounds up to 1.992... use a clearer
|
||||
case: 1.001 ceiling at 2dp -> 1.01. }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money;
|
||||
begin WriteLn(MoneyFromStr('1.001', 'USD', rmCeiling).AmountString()) end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('1.001 ceiling -> 1.01', '1.01', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_FromDecimal_RoundingMode;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money, Numerics.Decimal;
|
||||
var M: TMoney;
|
||||
begin
|
||||
M := MoneyFromDecimal(DecFromStr('2.345'), 'USD', rmHalfUp);
|
||||
WriteLn(M.AmountString())
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('2.345 halfUp -> 2.35', '2.35', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_Add_RoundingMode;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ Two values whose common scale exceeds the currency scale; rmHalfUp on Add. }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money, Numerics.Decimal;
|
||||
var A, C: TMoney;
|
||||
begin
|
||||
A := MoneyFromDecimal(DecFromStr('1.004'), 'USD', rmDown); { 1.00 }
|
||||
C := A.Add(MoneyFromDecimal(DecFromStr('2.005'), 'USD', rmDown), rmHalfUp);
|
||||
WriteLn(C.AmountString())
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
{ A=1.00; the addend is normalised by rmDown to 2.00, so 1.00+2.00 = 3.00. }
|
||||
AssertEquals('add @halfUp', '3.00', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_Multiply_RoundingMode_Ceiling;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ 10.00 * 1.0851 = 10.851 -> ceiling at 2dp -> 10.86. }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money, Numerics.Decimal;
|
||||
var M: TMoney;
|
||||
begin
|
||||
M := MoneyFromStr('10.00', 'USD').Multiply(DecFromStr('1.0851'), rmCeiling);
|
||||
WriteLn(M.AmountString())
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('mul @ceiling', '10.86', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_FromStr_CustomStrategy_Truncates;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ A custom IRoundingStrategy that always truncates (never increments). }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money, Numerics.Decimal;
|
||||
type
|
||||
TTrunc = class(TObject, IRoundingStrategy)
|
||||
function RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;
|
||||
DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;
|
||||
end;
|
||||
function TTrunc.RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;
|
||||
DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;
|
||||
begin Result := False end;
|
||||
var M: TMoney; S: IRoundingStrategy;
|
||||
begin
|
||||
S := TTrunc.Create;
|
||||
M := MoneyFromStr('9.999', 'USD', S);
|
||||
WriteLn(M.AmountString())
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('custom truncate -> 9.99', '9.99', Trim(Output));
|
||||
end;
|
||||
|
||||
procedure TE2EMoneyTests.TestRun_DefaultIsBankers;
|
||||
var Output: string; RCode: Integer;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
{ The no-mode overloads keep banker's: 2.5 and 3.5 at scale 0 -> 2 and 4. }
|
||||
AssertTrue('compile+run', CompileAndRunWithRTL(
|
||||
'''
|
||||
program P; uses Numerics.Money;
|
||||
begin
|
||||
WriteLn(MoneyFromStr('2.5', 'JPY').AmountString(), ' ',
|
||||
MoneyFromStr('3.5', 'JPY').AmountString())
|
||||
end.
|
||||
''', Output, RCode));
|
||||
AssertEquals('exit code', 0, RCode);
|
||||
AssertEquals('banker default', '2 4', Trim(Output));
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Registry }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
|
|||
|
|
@ -55,6 +55,13 @@ type
|
|||
procedure TestSemantic_IsZero_ReturnsBoolean_OK;
|
||||
procedure TestSemantic_Sign_ReturnsInteger_OK;
|
||||
|
||||
{ --- Rounding overloads --- }
|
||||
procedure TestSemantic_FromStr_RoundingMode_OK;
|
||||
procedure TestSemantic_FromStr_Strategy_OK;
|
||||
procedure TestSemantic_FromDecimal_RoundingMode_OK;
|
||||
procedure TestSemantic_Add_RoundingMode_OK;
|
||||
procedure TestSemantic_Multiply_Strategy_OK;
|
||||
|
||||
{ --- Type errors --- }
|
||||
procedure TestSemantic_FromStr_WrongArgType_Error;
|
||||
procedure TestSemantic_AssignMoneyToInt_Error;
|
||||
|
|
@ -302,6 +309,49 @@ begin
|
|||
'begin A := MoneyFromInt(1, ''USD''); I := A.Sign() end.');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Rounding overloads }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TMoneyIRTests.TestSemantic_FromStr_RoundingMode_OK;
|
||||
begin
|
||||
SemanticOK(
|
||||
'program P; uses Numerics.Money, Numerics.Decimal; var M: TMoney; ' +
|
||||
'begin M := MoneyFromStr(''1.005'', ''USD'', rmHalfUp) end.');
|
||||
end;
|
||||
|
||||
procedure TMoneyIRTests.TestSemantic_FromStr_Strategy_OK;
|
||||
begin
|
||||
SemanticOK(
|
||||
'program P; uses Numerics.Money, Numerics.Decimal; ' +
|
||||
'var M: TMoney; S: IRoundingStrategy; ' +
|
||||
'begin S := StandardRounding(rmHalfUp); M := MoneyFromStr(''1.005'', ''USD'', S) end.');
|
||||
end;
|
||||
|
||||
procedure TMoneyIRTests.TestSemantic_FromDecimal_RoundingMode_OK;
|
||||
begin
|
||||
SemanticOK(
|
||||
'program P; uses Numerics.Money, Numerics.Decimal; var M: TMoney; ' +
|
||||
'begin M := MoneyFromDecimal(DecFromStr(''1.005''), ''USD'', rmCeiling) end.');
|
||||
end;
|
||||
|
||||
procedure TMoneyIRTests.TestSemantic_Add_RoundingMode_OK;
|
||||
begin
|
||||
SemanticOK(
|
||||
'program P; uses Numerics.Money, Numerics.Decimal; var A, B, C: TMoney; ' +
|
||||
'begin A := MoneyFromInt(1, ''USD''); B := MoneyFromInt(2, ''USD''); ' +
|
||||
'C := A.Add(B, rmDown) end.');
|
||||
end;
|
||||
|
||||
procedure TMoneyIRTests.TestSemantic_Multiply_Strategy_OK;
|
||||
begin
|
||||
SemanticOK(
|
||||
'program P; uses Numerics.Money, Numerics.Decimal; ' +
|
||||
'var A, C: TMoney; S: IRoundingStrategy; ' +
|
||||
'begin A := MoneyFromInt(1, ''USD''); S := StandardRounding(rmFloor); ' +
|
||||
'C := A.Multiply(DecFromStr(''1.5''), S) end.');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Type errors }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
|
|||
|
|
@ -5046,7 +5046,13 @@ currency policy lives entirely in this wrapper. Three rules define `TMoney`:
|
|||
|
||||
* Each currency has a default minor-unit scale (JPY 0, USD 2, KWD 3, fallback 2).
|
||||
Every `TMoney` is normalised to its currency's scale on construction and after
|
||||
every arithmetic operation, using banker's rounding (`rmHalfEven`).
|
||||
every arithmetic operation. The default rounding is banker's (`rmHalfEven`),
|
||||
but it is not hard-wired: each constructor and rounding-sensitive operation has
|
||||
overloads taking an explicit `TRoundingMode` or a custom `IRoundingStrategy`
|
||||
(the same eight modes and extension point as `TDecimal`), so the rounding
|
||||
policy is swappable per call — e.g. `rmHalfUp` for a jurisdiction that rounds
|
||||
halves up, or an `IRoundingStrategy` implementing Swedish/Swiss 0.05 cash
|
||||
rounding.
|
||||
|
||||
* Arithmetic across different currencies (`Add`, `Subtract`, `Compare`) raises
|
||||
`EMoneyMismatch`. There is no implicit conversion — exchange rates are a
|
||||
|
|
|
|||
|
|
@ -26,10 +26,15 @@ unit Numerics.Money;
|
|||
|
||||
- Each currency has a default minor-unit scale: JPY 0, USD 2, KWD 3, and a
|
||||
fallback of 2 for unknown codes. Every TMoney is NORMALISED to its
|
||||
currency's scale on construction and after every arithmetic operation,
|
||||
using banker's rounding (rmHalfEven) — the recommended money default.
|
||||
So MoneyFromStr('1.005', 'USD') stores 1.00, and a JPY amount never
|
||||
carries a fraction.
|
||||
currency's scale on construction and after every arithmetic operation.
|
||||
The default rounding is banker's (rmHalfEven) — the recommended money
|
||||
default — so MoneyFromStr('1.005', 'USD') stores 1.00 and a JPY amount
|
||||
never carries a fraction. Each constructor and rounding-sensitive
|
||||
operation also has overloads taking an explicit TRoundingMode or a custom
|
||||
IRoundingStrategy (the same eight modes + extension point as TDecimal), so
|
||||
the rounding policy can be swapped per call — e.g. rmHalfUp for a
|
||||
jurisdiction that rounds halves up, or an IRoundingStrategy implementing
|
||||
Swedish/Swiss 0.05 cash rounding.
|
||||
|
||||
- Mismatched-currency arithmetic RAISES EMoneyMismatch. Add, Subtract and
|
||||
Compare across different currencies are programming errors, not silent
|
||||
|
|
@ -87,31 +92,43 @@ type
|
|||
function Sign: Integer;
|
||||
|
||||
{ Sum of Self and B. Both must be the same currency; the result is in that
|
||||
currency, normalised to its scale.
|
||||
currency, normalised to its scale. The no-mode form uses banker's
|
||||
rounding (rmHalfEven); the others let the caller pick the rounding mode or
|
||||
a custom strategy for the (rare) case where the addends' common scale
|
||||
exceeds the currency scale.
|
||||
@param B the amount to add.
|
||||
@returns Self + B.
|
||||
@raises EMoneyMismatch if the currencies differ. }
|
||||
function Add(const B: TMoney): TMoney;
|
||||
function Add(const B: TMoney): TMoney; overload;
|
||||
function Add(const B: TMoney; Mode: TRoundingMode): TMoney; overload;
|
||||
function Add(const B: TMoney; const Strategy: IRoundingStrategy): TMoney; overload;
|
||||
|
||||
{ Difference Self - B. Both must be the same currency.
|
||||
{ Difference Self - B. Both must be the same currency. Rounding control as
|
||||
for Add.
|
||||
@param B the amount to subtract.
|
||||
@returns Self - B.
|
||||
@raises EMoneyMismatch if the currencies differ. }
|
||||
function Subtract(const B: TMoney): TMoney;
|
||||
function Subtract(const B: TMoney): TMoney; overload;
|
||||
function Subtract(const B: TMoney; Mode: TRoundingMode): TMoney; overload;
|
||||
function Subtract(const B: TMoney; const Strategy: IRoundingStrategy): TMoney; overload;
|
||||
|
||||
{ Arithmetic negation (-Self), same currency and scale.
|
||||
{ Arithmetic negation (-Self), same currency and scale. Exact — no rounding.
|
||||
@returns the amount with opposite sign. }
|
||||
function Negate: TMoney;
|
||||
|
||||
{ Scales the amount by a dimensionless TDecimal factor (e.g. unit price *
|
||||
quantity, or amount * tax-rate), re-normalising to the currency scale with
|
||||
banker's rounding. The currency is preserved.
|
||||
quantity, or amount * tax-rate), re-normalising to the currency scale.
|
||||
The no-mode form uses banker's rounding (rmHalfEven); the others take an
|
||||
explicit rounding mode or custom strategy. The currency is preserved.
|
||||
@param Factor the multiplier.
|
||||
@returns Self * Factor at the currency scale. }
|
||||
function Multiply(const Factor: TDecimal): TMoney;
|
||||
function Multiply(const Factor: TDecimal): TMoney; overload;
|
||||
function Multiply(const Factor: TDecimal; Mode: TRoundingMode): TMoney; overload;
|
||||
function Multiply(const Factor: TDecimal; const Strategy: IRoundingStrategy): TMoney; overload;
|
||||
|
||||
{ Scales the amount by an integer quantity. Exact (no rounding needed
|
||||
beyond the existing scale). The currency is preserved.
|
||||
{ Scales the amount by an integer quantity. Exact at the currency scale (an
|
||||
integer multiply introduces no new fraction digits), so no rounding mode is
|
||||
needed. The currency is preserved.
|
||||
@param Quantity the integer multiplier.
|
||||
@returns Self * Quantity. }
|
||||
function MultiplyInt(Quantity: Integer): TMoney;
|
||||
|
|
@ -145,22 +162,37 @@ type
|
|||
|
||||
{ Builds a TMoney from a decimal literal string and a currency code. The
|
||||
amount is parsed exactly (see DecFromStr) then normalised to the currency's
|
||||
default scale with banker's rounding.
|
||||
default scale. The no-mode form uses banker's rounding (rmHalfEven); the
|
||||
others take an explicit rounding mode or a custom strategy.
|
||||
@param AAmount the decimal literal (e.g. '19.99', '-0.005').
|
||||
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
|
||||
@param Mode the rounding mode (mode overload).
|
||||
@param Strategy the rounding strategy (strategy overload).
|
||||
@returns the money value.
|
||||
@raises EDecimalParse if AAmount is malformed. }
|
||||
function MoneyFromStr(const AAmount, ACurrency: string): TMoney;
|
||||
function MoneyFromStr(const AAmount, ACurrency: string): TMoney; overload;
|
||||
function MoneyFromStr(const AAmount, ACurrency: string;
|
||||
Mode: TRoundingMode): TMoney; overload;
|
||||
function MoneyFromStr(const AAmount, ACurrency: string;
|
||||
const Strategy: IRoundingStrategy): TMoney; overload;
|
||||
|
||||
{ Builds a TMoney from an existing TDecimal amount and a currency code. The
|
||||
amount is normalised to the currency's default scale (banker's rounding).
|
||||
{ Builds a TMoney from an existing TDecimal amount and a currency code,
|
||||
normalised to the currency's default scale (banker's rounding by default; the
|
||||
mode/strategy overloads override it).
|
||||
@param AAmount the decimal amount.
|
||||
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
|
||||
@param Mode the rounding mode (mode overload).
|
||||
@param Strategy the rounding strategy (strategy overload).
|
||||
@returns the money value. }
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney;
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney; overload;
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
|
||||
Mode: TRoundingMode): TMoney; overload;
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
|
||||
const Strategy: IRoundingStrategy): TMoney; overload;
|
||||
|
||||
{ Builds a TMoney from a whole-unit integer amount and a currency code
|
||||
(e.g. MoneyFromInt(5, 'USD') = 5.00 USD).
|
||||
(e.g. MoneyFromInt(5, 'USD') = 5.00 USD). An integer is exact at any
|
||||
currency scale, so no rounding mode is needed.
|
||||
@param AAmount the whole-unit integer amount.
|
||||
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
|
||||
@returns the money value. }
|
||||
|
|
@ -206,30 +238,69 @@ begin
|
|||
Result := cDefaultScale;
|
||||
end;
|
||||
|
||||
{ Normalises ADec to ACurrency's scale with banker's rounding and pairs it with
|
||||
the upper-cased code. Central constructor used by every public builder so the
|
||||
invariant "FAmount is always at the currency scale" holds in one place. }
|
||||
function MakeMoney(const ADec: TDecimal; const ACurrency: string): TMoney;
|
||||
{ Normalises ADec to ACurrency's scale with the given rounding strategy and
|
||||
pairs it with the upper-cased code. Central constructor used by every public
|
||||
builder so the invariant "FAmount is always at the currency scale" holds in
|
||||
one place. }
|
||||
function MakeMoneyS(const ADec: TDecimal; const ACurrency: string;
|
||||
const AStrategy: IRoundingStrategy): TMoney;
|
||||
var
|
||||
Code: string;
|
||||
Norm: TDecimal;
|
||||
begin
|
||||
Code := UpperCase(ACurrency);
|
||||
Norm := ADec.RoundTo(CurrencyScale(Code), rmHalfEven);
|
||||
Norm := ADec.RoundTo(CurrencyScale(Code), AStrategy);
|
||||
Result.FAmount := Norm;
|
||||
Result.FCurrency := Code;
|
||||
end;
|
||||
|
||||
{ As MakeMoneyS but selecting one of the eight standard rounding modes. }
|
||||
function MakeMoneyM(const ADec: TDecimal; const ACurrency: string;
|
||||
AMode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyS(ADec, ACurrency, StandardRounding(AMode));
|
||||
end;
|
||||
|
||||
{ Default normalisation: banker's rounding (rmHalfEven). }
|
||||
function MakeMoney(const ADec: TDecimal; const ACurrency: string): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyM(ADec, ACurrency, rmHalfEven);
|
||||
end;
|
||||
|
||||
function MoneyFromStr(const AAmount, ACurrency: string): TMoney;
|
||||
begin
|
||||
Result := MakeMoney(DecFromStr(AAmount), ACurrency);
|
||||
end;
|
||||
|
||||
function MoneyFromStr(const AAmount, ACurrency: string;
|
||||
Mode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyM(DecFromStr(AAmount), ACurrency, Mode);
|
||||
end;
|
||||
|
||||
function MoneyFromStr(const AAmount, ACurrency: string;
|
||||
const Strategy: IRoundingStrategy): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyS(DecFromStr(AAmount), ACurrency, Strategy);
|
||||
end;
|
||||
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney;
|
||||
begin
|
||||
Result := MakeMoney(AAmount, ACurrency);
|
||||
end;
|
||||
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
|
||||
Mode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyM(AAmount, ACurrency, Mode);
|
||||
end;
|
||||
|
||||
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
|
||||
const Strategy: IRoundingStrategy): TMoney;
|
||||
begin
|
||||
Result := MakeMoneyS(AAmount, ACurrency, Strategy);
|
||||
end;
|
||||
|
||||
function MoneyFromInt(AAmount: Integer; const ACurrency: string): TMoney;
|
||||
begin
|
||||
Result := MakeMoney(DecFromInt(AAmount), ACurrency);
|
||||
|
|
@ -269,22 +340,42 @@ begin
|
|||
Result := Self.FAmount.Sign();
|
||||
end;
|
||||
|
||||
function TMoney.Add(const B: TMoney): TMoney;
|
||||
function TMoney.Add(const B: TMoney; const Strategy: IRoundingStrategy): TMoney;
|
||||
var
|
||||
Sum: TDecimal;
|
||||
begin
|
||||
RequireSameCurrency(Self, B, 'add');
|
||||
Sum := Self.FAmount.Add(B.FAmount);
|
||||
Result := MakeMoney(Sum, Self.FCurrency);
|
||||
Result := MakeMoneyS(Sum, Self.FCurrency, Strategy);
|
||||
end;
|
||||
|
||||
function TMoney.Subtract(const B: TMoney): TMoney;
|
||||
function TMoney.Add(const B: TMoney; Mode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := Self.Add(B, StandardRounding(Mode));
|
||||
end;
|
||||
|
||||
function TMoney.Add(const B: TMoney): TMoney;
|
||||
begin
|
||||
Result := Self.Add(B, StandardRounding(rmHalfEven));
|
||||
end;
|
||||
|
||||
function TMoney.Subtract(const B: TMoney; const Strategy: IRoundingStrategy): TMoney;
|
||||
var
|
||||
Diff: TDecimal;
|
||||
begin
|
||||
RequireSameCurrency(Self, B, 'subtract');
|
||||
Diff := Self.FAmount.Subtract(B.FAmount);
|
||||
Result := MakeMoney(Diff, Self.FCurrency);
|
||||
Result := MakeMoneyS(Diff, Self.FCurrency, Strategy);
|
||||
end;
|
||||
|
||||
function TMoney.Subtract(const B: TMoney; Mode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := Self.Subtract(B, StandardRounding(Mode));
|
||||
end;
|
||||
|
||||
function TMoney.Subtract(const B: TMoney): TMoney;
|
||||
begin
|
||||
Result := Self.Subtract(B, StandardRounding(rmHalfEven));
|
||||
end;
|
||||
|
||||
function TMoney.Negate: TMoney;
|
||||
|
|
@ -295,12 +386,22 @@ begin
|
|||
Result := MakeMoney(Neg, Self.FCurrency);
|
||||
end;
|
||||
|
||||
function TMoney.Multiply(const Factor: TDecimal): TMoney;
|
||||
function TMoney.Multiply(const Factor: TDecimal; const Strategy: IRoundingStrategy): TMoney;
|
||||
var
|
||||
Prod: TDecimal;
|
||||
begin
|
||||
Prod := Self.FAmount.Multiply(Factor);
|
||||
Result := MakeMoney(Prod, Self.FCurrency);
|
||||
Result := MakeMoneyS(Prod, Self.FCurrency, Strategy);
|
||||
end;
|
||||
|
||||
function TMoney.Multiply(const Factor: TDecimal; Mode: TRoundingMode): TMoney;
|
||||
begin
|
||||
Result := Self.Multiply(Factor, StandardRounding(Mode));
|
||||
end;
|
||||
|
||||
function TMoney.Multiply(const Factor: TDecimal): TMoney;
|
||||
begin
|
||||
Result := Self.Multiply(Factor, StandardRounding(rmHalfEven));
|
||||
end;
|
||||
|
||||
function TMoney.MultiplyInt(Quantity: Integer): TMoney;
|
||||
|
|
|
|||
Loading…
Reference in a new issue