Денежный тип -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.137.192.3]

Модераторы: jack128, Rouse_, Krid

Денежный тип , Delphi 2010

Romkin

Сообщ. #1 , 18.04.11, 11:54

Profi

Профиль · PM

Поощрения: 6 Dgm

Рейтинг (т): 156

Тип TMoney

Лично мне его очень не хватало лет десять назад, простого типа данных, который обеспечивает контроль над операциями с валютой.
Просто Double или currency не слишком подходят, достаточно велика вероятность что сложат доллары с фунтами или еще что-нибудь.
Предлагается, по моему мнению, простейшая реализация типа TMoney, на основе Currency. Задачей было обеспечить контроль типа валюты.
Надо заметить, что деньги легко складывать и вычитать (в одной валюте), а вот умножать и делить их друг на друга нельзя, поэтому вместо умножения двух TMoney сделан метод умножения на коэффициент.
Вот что получилось, сначала описание типа "валюта".

unit CurrencyList;

{

Модуль списка валют

}

interface

type

TCurrName = String[3];

TCurrency = record

private

FName: TCurrName;

public

property Name: TCurrName read FName;

end;

// Список значений валют по ISO 4217

// Имя кнстанты соответствует имени валюты с приставкой 'c'

const

{$REGION 'Длинный список констант валют'}

cAFN: TCurrency = (FName: 'AFN');

cALL: TCurrency = (FName: 'ALL');

cAMD: TCurrency = (FName: 'AMD');

cANG: TCurrency = (FName: 'ANG');

cAOA: TCurrency = (FName: 'AOA');

cARS: TCurrency = (FName: 'ARS');

cAUD: TCurrency = (FName: 'AUD');

cAWG: TCurrency = (FName: 'AWG');

cAZN: TCurrency = (FName: 'AZN');

cBAM: TCurrency = (FName: 'BAM');

cBBD: TCurrency = (FName: 'BBD');

cBDT: TCurrency = (FName: 'BDT');

cBGN: TCurrency = (FName: 'BGN');

cBHD: TCurrency = (FName: 'BHD');

cBIF: TCurrency = (FName: 'BIF');

cBMD: TCurrency = (FName: 'BMD');

cBND: TCurrency = (FName: 'BND');

cBOB: TCurrency = (FName: 'BOB');

cBOV: TCurrency = (FName: 'BOV');

cBRL: TCurrency = (FName: 'BRL');

cBSD: TCurrency = (FName: 'BSD');

cBTN: TCurrency = (FName: 'BTN');

cBWP: TCurrency = (FName: 'BWP');

cBYR: TCurrency = (FName: 'BYR');

cBZD: TCurrency = (FName: 'BZD');

cCAD: TCurrency = (FName: 'CAD');

cCDF: TCurrency = (FName: 'CDF');

cCHE: TCurrency = (FName: 'CHE');

cCHF: TCurrency = (FName: 'CHF');

cCHW: TCurrency = (FName: 'CHW');

cCLF: TCurrency = (FName: 'CLF');

cCLP: TCurrency = (FName: 'CLP');

cCNY: TCurrency = (FName: 'CNY');

cCOP: TCurrency = (FName: 'COP');

cCOU: TCurrency = (FName: 'COU');

cCRC: TCurrency = (FName: 'CRC');

cCUC: TCurrency = (FName: 'CUC');

cCUP: TCurrency = (FName: 'CUP');

cCVE: TCurrency = (FName: 'CVE');

cCZK: TCurrency = (FName: 'CZK');

cDJF: TCurrency = (FName: 'DJF');

cDKK: TCurrency = (FName: 'DKK');

cDOP: TCurrency = (FName: 'DOP');

cDZD: TCurrency = (FName: 'DZD');

cEGP: TCurrency = (FName: 'EGP');

cERN: TCurrency = (FName: 'ERN');

cETB: TCurrency = (FName: 'ETB');

cEUR: TCurrency = (FName: 'EUR');

cFJD: TCurrency = (FName: 'FJD');

cFKP: TCurrency = (FName: 'FKP');

cGBP: TCurrency = (FName: 'GBP');

cGEL: TCurrency = (FName: 'GEL');

cGHS: TCurrency = (FName: 'GHS');

cGIP: TCurrency = (FName: 'GIP');

cGMD: TCurrency = (FName: 'GMD');

cGNF: TCurrency = (FName: 'GNF');

cGTQ: TCurrency = (FName: 'GTQ');

cGYD: TCurrency = (FName: 'GYD');

cHKD: TCurrency = (FName: 'HKD');

cHNL: TCurrency = (FName: 'HNL');

cHRK: TCurrency = (FName: 'HRK');

cHTG: TCurrency = (FName: 'HTG');

cHUF: TCurrency = (FName: 'HUF');

cIDR: TCurrency = (FName: 'IDR');

cILS: TCurrency = (FName: 'ILS');

cINR: TCurrency = (FName: 'INR');

cIQD: TCurrency = (FName: 'IQD');

cIRR: TCurrency = (FName: 'IRR');

cISK: TCurrency = (FName: 'ISK');

cJMD: TCurrency = (FName: 'JMD');

cJOD: TCurrency = (FName: 'JOD');

cJPY: TCurrency = (FName: 'JPY');

cKES: TCurrency = (FName: 'KES');

cKGS: TCurrency = (FName: 'KGS');

cKHR: TCurrency = (FName: 'KHR');

cKMF: TCurrency = (FName: 'KMF');

cKPW: TCurrency = (FName: 'KPW');

cKRW: TCurrency = (FName: 'KRW');

cKWD: TCurrency = (FName: 'KWD');

cKYD: TCurrency = (FName: 'KYD');

cKZT: TCurrency = (FName: 'KZT');

cLAK: TCurrency = (FName: 'LAK');

cLBP: TCurrency = (FName: 'LBP');

cLKR: TCurrency = (FName: 'LKR');

cLRD: TCurrency = (FName: 'LRD');

cLSL: TCurrency = (FName: 'LSL');

cLTL: TCurrency = (FName: 'LTL');

cLVL: TCurrency = (FName: 'LVL');

cLYD: TCurrency = (FName: 'LYD');

cMAD: TCurrency = (FName: 'MAD');

cMDL: TCurrency = (FName: 'MDL');

cMGA: TCurrency = (FName: 'MGA');

cMKD: TCurrency = (FName: 'MKD');

cMMK: TCurrency = (FName: 'MMK');

cMNT: TCurrency = (FName: 'MNT');

cMOP: TCurrency = (FName: 'MOP');

cMRO: TCurrency = (FName: 'MRO');

cMUR: TCurrency = (FName: 'MUR');

cMVR: TCurrency = (FName: 'MVR');

cMWK: TCurrency = (FName: 'MWK');

cMXN: TCurrency = (FName: 'MXN');

cMXV: TCurrency = (FName: 'MXV');

cMYR: TCurrency = (FName: 'MYR');

cMZN: TCurrency = (FName: 'MZN');

cNAD: TCurrency = (FName: 'NAD');

cNGN: TCurrency = (FName: 'NGN');

cNIO: TCurrency = (FName: 'NIO');

cNOK: TCurrency = (FName: 'NOK');

cNPR: TCurrency = (FName: 'NPR');

cNZD: TCurrency = (FName: 'NZD');

cOMR: TCurrency = (FName: 'OMR');

cPAB: TCurrency = (FName: 'PAB');

cPEN: TCurrency = (FName: 'PEN');

cPGK: TCurrency = (FName: 'PGK');

cPHP: TCurrency = (FName: 'PHP');

cPKR: TCurrency = (FName: 'PKR');

cPLN: TCurrency = (FName: 'PLN');

cPYG: TCurrency = (FName: 'PYG');

cQAR: TCurrency = (FName: 'QAR');

cRON: TCurrency = (FName: 'RON');

cRSD: TCurrency = (FName: 'RSD');

cRUB: TCurrency = (FName: 'RUB');

cRWF: TCurrency = (FName: 'RWF');

cSAR: TCurrency = (FName: 'SAR');

cSBD: TCurrency = (FName: 'SBD');

cSCR: TCurrency = (FName: 'SCR');

cSDG: TCurrency = (FName: 'SDG');

cSEK: TCurrency = (FName: 'SEK');

cSGD: TCurrency = (FName: 'SGD');

cSHP: TCurrency = (FName: 'SHP');

cSLL: TCurrency = (FName: 'SLL');

cSOS: TCurrency = (FName: 'SOS');

cSRD: TCurrency = (FName: 'SRD');

cSTD: TCurrency = (FName: 'STD');

cSVC: TCurrency = (FName: 'SVC');

cSYP: TCurrency = (FName: 'SYP');

cSZL: TCurrency = (FName: 'SZL');

cTHB: TCurrency = (FName: 'THB');

cTJS: TCurrency = (FName: 'TJS');

cTMT: TCurrency = (FName: 'TMT');

cTND: TCurrency = (FName: 'TND');

cTOP: TCurrency = (FName: 'TOP');

cTRY: TCurrency = (FName: 'TRY');

cTTD: TCurrency = (FName: 'TTD');

cTWD: TCurrency = (FName: 'TWD');

cTZS: TCurrency = (FName: 'TZS');

cUAH: TCurrency = (FName: 'UAH');

cUGX: TCurrency = (FName: 'UGX');

cUSD: TCurrency = (FName: 'USD');

cUSN: TCurrency = (FName: 'USN');

cUSS: TCurrency = (FName: 'USS');

cUYI: TCurrency = (FName: 'UYI');

cUYU: TCurrency = (FName: 'UYU');

cUZS: TCurrency = (FName: 'UZS');

cVEF: TCurrency = (FName: 'VEF');

cVND: TCurrency = (FName: 'VND');

cVUV: TCurrency = (FName: 'VUV');

cWST: TCurrency = (FName: 'WST');

cXAF: TCurrency = (FName: 'XAF');

cXAG: TCurrency = (FName: 'XAG');

cXAU: TCurrency = (FName: 'XAU');

cXBA: TCurrency = (FName: 'XBA');

cXBB: TCurrency = (FName: 'XBB');

cXBC: TCurrency = (FName: 'XBC');

cXBD: TCurrency = (FName: 'XBD');

cXCD: TCurrency = (FName: 'XCD');

cXDR: TCurrency = (FName: 'XDR');

cXFU: TCurrency = (FName: 'XFU');

cXOF: TCurrency = (FName: 'XOF');

cXPD: TCurrency = (FName: 'XPD');

cXPF: TCurrency = (FName: 'XPF');

cXPT: TCurrency = (FName: 'XPT');

cXSU: TCurrency = (FName: 'XSU');

cXTS: TCurrency = (FName: 'XTS');

cXUA: TCurrency = (FName: 'XUA');

cXXX: TCurrency = (FName: 'XXX');

cYER: TCurrency = (FName: 'YER');

cZAR: TCurrency = (FName: 'ZAR');

cZMK: TCurrency = (FName: 'ZMK');

cZWL: TCurrency = (FName: 'ZWL');

{$ENDREGION}

implementation

end.

Выглядит угрожающе, зато достаточно просто: стандарт меняется редко. Можно сделать и подгружаемый список, при желании.
Странная запись из одного поля сделана просто для read-only значений.

Скрытый текст

И не думайте, что я как обезьянка это набивал

Собственно TMoney:

unit Money;

{

Описание типа "деньги".

Простой способ, запись вида (валюта, сумма).

Роман Игнатьев, 2011

}

interface

uses SysUtils, CurrencyList;

type

///<summary>

/// Тип "деньги", для валютных сумм. Учет единиц измерения валюты.

/// Переменная должна инициализироваться конструктором.

///</summary>

TMoney = record

strict private

FCurrName: TCurrName;

FValue: currency;

class procedure CheckCurrency(CurrName1, CurrName2: TCurrName); static;

inline;

public

///<summary> Единственный способ инициализации </summary>

///<param name="ACurrency">

/// Инициализируется константой из CurrencyList

///</param>

///<param name="AValue">Начальное значение суммы</param>

constructor Create(ACurrency: TCurrency; AValue: currency);

class operator Add(A, B: TMoney): TMoney;

class operator Subtract(A, B: TMoney): TMoney;

class operator Negative(A: TMoney): TMoney;

class operator Positive(A: TMoney): TMoney;

///<summary> Умножение на безразмерный коэффициент </summary>

class operator Multiply(L: Double; R: TMoney): TMoney;

class operator Multiply(L: TMoney; R: Double): TMoney;

class operator Equal(A, B: TMoney): boolean;

class operator NotEqual(A, B: TMoney): boolean;

class operator GreaterThan(A, B: TMoney): boolean;

class operator GreaterThanOrEqual(A, B: TMoney): boolean;

class operator LessThan(A, B: TMoney): boolean;

class operator LessThanOrEqual(A, B: TMoney): boolean;

property CurrName: TCurrName read FCurrName;

property Value: currency read FValue;

end;

type

EMoneyError = class(EMathError);

resourcestring

strIncompatibleCurrency = 'Несовместимая валюта: %s и %s';

implementation

{ TMoney }

constructor TMoney.Create(ACurrency: TCurrency; AValue: currency);

begin

FCurrName := ACurrency.Name;

FValue := AValue;

end;

class procedure TMoney.CheckCurrency(CurrName1, CurrName2: TCurrName);

begin

if CurrName1 <> CurrName2 then

raise EMoneyError.CreateFmt(strIncompatibleCurrency,

[CurrName1, CurrName2]);

end;

class operator TMoney.Add(A, B: TMoney): TMoney;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result.FCurrName := A.FCurrName;

Result.FValue := A.FValue + B.FValue;

end;

class operator TMoney.Subtract(A, B: TMoney): TMoney;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result.FCurrName := A.FCurrName;

Result.FValue := A.FValue - B.FValue;

end;

class operator TMoney.Negative(A: TMoney): TMoney;

begin

Result.FCurrName := A.FCurrName;

Result.FValue := -A.FValue;

end;

class operator TMoney.Positive(A: TMoney): TMoney;

begin

Result.FCurrName := A.FCurrName;

Result.FValue := A.FValue;

end;

class operator TMoney.Multiply(L: Double; R: TMoney): TMoney;

begin

Result := R;

Result.FValue := Result.FValue * L;

end;

class operator TMoney.Multiply(L: TMoney; R: Double): TMoney;

begin

Result := L;

Result.FValue := Result.FValue * R;

end;

class operator TMoney.Equal(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue = B.FValue;

end;

class operator TMoney.NotEqual(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue <> B.FValue;

end;

class operator TMoney.GreaterThan(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue > B.FValue;

end;

class operator TMoney.GreaterThanOrEqual(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue >= B.FValue;

end;

class operator TMoney.LessThan(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue < B.FValue;

end;

class operator TMoney.LessThanOrEqual(A, B: TMoney): boolean;

begin

CheckCurrency(A.FCurrName, B.FCurrName);

Result := A.FValue <= B.FValue;

end;

end.

Два поля, CurrName (имя валюты) и Value, собственно значение суммы.
Единственный способ задать начальное значение это вызов конструктора. В который надо подать значение TCurrency, константу.
При арифметических действиях и сравнениях осуществляется проверка на одинаковые единицы измерения.
Больше ничего в этом типе не должно быть, пересчет и форматирование совсем другие задачи.

Сообщение отредактировано: Romkin - 04.05.11, 09:11

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0226 ] [ 16 queries used ] [ Generated: 16.04.24, 16:50 GMT ]