1unit money;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8  Classes, SysUtils;
9
10type
11
12  TMoney = class;
13  TMoneyBag = class;
14
15  IMoney = interface
16  ['{2E0160F6-312C-D911-8DE5-DD8AC3E7C6F4}']
17  function add(m: IMoney): IMoney;
18  function addMoney(m: TMoney): IMoney;
19  function addMoneyBag(mb: TMoneyBag): IMoney;
20  function isZero: boolean;
21  function multiply(factor: integer): IMoney;
22  function negate: IMoney;
23  function subtract(m: IMoney): IMoney;
24  procedure appendTo(m: TMoneyBag);
25  function toString: String;
26  function equals(m: IMoney): boolean;
27  function Count: integer;
28  function _Self: TObject;
29  end;
30
31  ISingleCurrencyMoney = interface(IMoney)
32  ['{D6D97717-E52D-D911-83C4-8233402A6B6C}']
33  function GetCurrencyUnit: string;
34  function GetAmount: int64;
35  property Amount: int64 read GetAmount;
36  property CurrencyUnit: string read GetCurrencyUnit;
37  end;
38
39  TMoney = class(TInterfacedObject, IMoney, ISingleCurrencyMoney)
40  private
41    FAmount: int64;
42    FCurrencyUnit: String;
43    function GetAmount: int64;
44    function GetCurrencyUnit: string;
45  public
46    constructor Create(aAmount: int64; aCurrencyUnit: String);
47    function add(m: IMoney): IMoney;
48    function addMoney(m: TMoney): IMoney;
49    function addMoneyBag(mb: TMoneyBag): IMoney;
50    function isZero: Boolean;
51    function multiply(factor: Integer): IMoney;
52    function negate: IMoney;
53    function subtract(m: IMoney): IMoney;
54    procedure appendTo(m: TMoneyBag);
55    function toString: String;
56    function equals(m: IMoney): boolean;
57    property Amount: int64 read GetAmount;
58    property CurrencyUnit: string read GetCurrencyUnit;
59    function Count: integer;
60    function _Self: TObject;
61  end;
62
63  TMoneyBag = class(TInterfacedObject, IMoney)
64  private
65    FMonies: TInterfaceList;
66    function FindMoney(aCurrencyUnit: string): Integer;
67    function Contains(m: ISingleCurrencyMoney): boolean;
68  public
69    constructor Create;
70    class function CreateWith(m1: IMoney; m2: IMoney): IMoney;
71    destructor Destroy; override;
72    function Simplify: IMoney;
73    function add(m: IMoney): IMoney;
74    function addMoney(m: TMoney): IMoney;
75    function addMoneyBag(mb: TMoneyBag): IMoney;
76    procedure appendBag(aBag: TMoneyBag);
77    procedure appendMoney(aMoney: ISingleCurrencyMoney);
78    function isZero: boolean;
79    function multiply(factor: integer): IMoney;
80    function negate: IMoney;
81    function subtract(m: IMoney): IMoney;
82    procedure appendTo(m: TMoneyBag);
83    function toString: String;
84    function equals(m: IMoney): boolean;
85    function Count: integer;
86    function _Self: TObject;
87  end;
88
89  Operator + (c: IMoney; c1: IMoney) c2: IMoney;
90  Operator - (c: IMoney; c1: IMoney) c2: IMoney;
91  Operator * (c: IMoney; i: integer) c2: IMoney;
92
93implementation
94
95Operator + (c: IMoney; c1: IMoney) c2: IMoney;
96begin
97  c2 := c.add(c1);
98end;
99
100Operator - (c: IMoney; c1: IMoney) c2: IMoney;
101begin
102  c2 := c.subtract(c1);
103end;
104
105Operator * (c: IMoney; i: integer) c2: IMoney;
106begin
107  c2 := c.multiply(i);
108end;
109
110
111function TMoneyBag.FindMoney(aCurrencyUnit: string): Integer;
112var
113  i: Integer;
114begin
115  for i := 0 to FMonies.Count - 1 do
116    if (FMonies.items[i] as ISingleCurrencyMoney).CurrencyUnit = aCurrencyUnit then
117    begin
118      Result := i;
119      Exit;
120    end;
121  result := -1;
122end;
123
124function TMoneyBag.Contains(m: ISingleCurrencyMoney): boolean;
125var
126  idx: integer;
127begin
128  idx := FindMoney(m.CurrencyUnit);
129  if idx = -1 then
130  begin
131    Result := false;
132    Exit;
133  end;
134  Result := ((FMonies[idx] as ISingleCurrencyMoney).Amount = m.amount);
135end;
136
137class function TMoneyBag.CreateWith(m1: IMoney; m2: IMoney): IMoney;
138var
139  mb: IMoney;
140begin
141  mb := TMoneyBag.Create;
142  m1.AppendTo(TMoneyBag(mb._Self));
143  m2.AppendTo(TMoneyBag(mb._Self));
144  Result := TMoneyBag(mb._Self).Simplify;
145end;
146
147constructor TMoneyBag.Create;
148begin
149  FMonies := TInterfaceList.Create;
150end;
151
152destructor TMoneyBag.Destroy;
153begin
154  FMonies.Free;
155  inherited Destroy;
156end;
157
158function TMoneyBag.Simplify: IMoney;
159begin
160  if FMonies.Count = 1 then
161    Result := FMonies.items[0] as IMoney
162  else
163    Result := Self;
164end;
165
166function TMoneyBag.add(m: IMoney): IMoney;
167begin
168  Result := m.AddMoneyBag(Self);
169end;
170
171function TMoneyBag.addMoney(m: TMoney): IMoney;
172begin
173  Result := TMoneyBag.CreateWith(m, Self);
174end;
175
176function TMoneyBag.addMoneyBag(mb: TMoneyBag): IMoney;
177begin
178  Result := TMoneyBag.CreateWith(mb, Self);
179end;
180
181procedure TMoneyBag.appendBag(aBag: TMoneyBag);
182var
183  i: integer;
184begin
185  for i := 0 to aBag.FMonies.Count - 1 do
186    appendMoney(aBag.FMonies.Items[i] as ISingleCurrencyMoney);
187end;
188
189procedure TMoneyBag.appendMoney(aMoney: ISingleCurrencyMoney);
190var
191  i: integer;
192  old: IMoney;
193  sum: IMoney;
194begin
195  if aMoney.isZero then Exit;
196  i := FindMoney(aMoney.CurrencyUnit);
197  if i = -1 then
198  begin
199    FMonies.add(aMoney);
200    Exit;
201  end;
202  old := FMonies[i] as IMoney;
203  sum := old.Add(aMoney);
204  FMonies.Delete(i);
205  if sum.isZero then Exit;
206  FMonies.Add(sum);
207end;
208
209function TMoneyBag.isZero: boolean;
210begin
211  Result := FMonies.Count = 0;
212end;
213
214function TMoneyBag.multiply(factor: integer): IMoney;
215var
216  i: Integer;
217begin
218  Result := TMoneyBag.Create;
219  if factor <> 0 then
220    for i := 0 to FMonies.Count - 1 do
221    begin
222      TMoneyBag(Result._Self).appendMoney(
223      (FMonies.items[i] as ISingleCurrencyMoney).Multiply(factor) as ISingleCurrencyMoney);
224    end;
225end;
226
227function TMoneyBag.negate: IMoney;
228var
229  i: integer;
230begin
231  Result := TMoneyBag.Create;
232  for i := 0 to FMonies.Count - 1 do
233  begin
234    TMoneyBag(Result._Self).appendMoney(
235(FMonies.items[i] as ISingleCurrencyMoney).negate as ISingleCurrencyMoney);
236  end;
237end;
238
239function TMoneyBag.subtract(m: IMoney): IMoney;
240begin
241  Result := Add(m.negate);
242end;
243
244procedure TMoneyBag.appendTo(m: TMoneyBag);
245begin
246  m.AppendBag(Self);
247end;
248
249function TMoneyBag.toString: String;
250var
251  i: integer;
252begin
253  Result := '{';
254  for i := 0 to FMonies.Count - 1 do
255    Result := Result + (FMonies.items[i] as IMoney).ToString;
256  Result := Result + '}';
257end;
258
259function TMoneyBag.equals(m: IMoney): boolean;
260var
261  aMoneyBag: TMoneyBag;
262  i: integer;
263  ism: ISingleCurrencyMoney;
264begin
265  if m = nil then
266  begin
267    Result := false;
268    Exit;
269  end;
270  if isZero then
271  begin
272    Result := m.isZero;
273    Exit;
274  end;
275  if m._Self.ClassType = TMoneyBag then
276  begin
277    aMoneyBag := TMoneyBag(m._Self);
278    if aMoneyBag.FMonies.count <> FMonies.Count then
279    begin
280      Result := false;
281      Exit;
282    end;
283    for i := 0 to FMonies.Count - 1 do
284    begin
285      ism := FMonies.items[i] as ISingleCurrencyMoney;
286      if not aMoneyBag.Contains(ism) then
287      begin
288        Result := false;
289        Exit;
290      end;
291    end;
292    Result := true;
293    Exit;
294  end;
295  Result := false;
296end;
297
298function TMoneyBag.Count: integer;
299begin
300  Result := FMonies.Count;
301end;
302
303function TMoneyBag._Self: TObject;
304begin
305  Result := Self;
306end;
307
308
309{ TMoney }
310
311function TMoney.GetCurrencyUnit: string;
312begin
313  Result := FCurrencyUnit;
314end;
315
316function TMoney.GetAmount: int64;
317begin
318  Result := FAmount;
319end;
320
321constructor TMoney.Create(aAmount: int64; aCurrencyUnit: string);
322begin
323  FAmount := aAmount;
324  FCurrencyUnit := aCurrencyUnit;
325end;
326
327function TMoney.add(m: IMoney): IMoney;
328begin
329  Result := m.AddMoney(Self);
330end;
331
332function TMoney.addMoney(m: TMoney): IMoney;
333begin
334  if (m.CurrencyUnit = Self.CurrencyUnit) then
335    Result := TMoney.Create(Self.Amount + m.Amount, Self.CurrencyUnit)
336  else
337    Result := TMoneyBag.CreateWith(Self, M);
338end;
339
340function TMoney.addMoneyBag(mb: TMoneyBag): IMoney;
341begin
342  Result := mb.AddMoney(Self);
343end;
344
345function TMoney.isZero: Boolean;
346begin
347  Result := Amount = 0;
348end;
349
350function TMoney.multiply(factor: Integer): IMoney;
351begin
352  Result := TMoney.Create(Amount * factor, CurrencyUnit);
353end;
354
355function TMoney.negate: IMoney;
356begin
357  Result := TMoney.Create(- Amount, CurrencyUnit);
358end;
359
360function TMoney.subtract(m: IMoney): IMoney;
361begin
362  Result := Add(m.negate);
363end;
364
365procedure TMoney.appendTo(m: TMoneyBag);
366begin
367  m.AppendMoney(Self);
368end;
369
370function TMoney.toString: String;
371begin
372  Result := '[' + IntToStr(FAmount) + ' '+ FCurrencyUnit + ']';
373end;
374
375function TMoney.equals(m: IMoney): boolean;
376var
377  ism: ISingleCurrencyMoney;
378begin
379  if Assigned(m) then
380  begin
381    if isZero then
382         Result := m.isZero;
383    if m._Self.ClassType = TMoney  then
384    begin
385      ism := m as ISingleCurrencyMoney;
386       Result := (ism.Amount = Amount) and
387          (ism.CurrencyUnit = CurrencyUnit)
388    end
389    else
390      Result := false;
391  end
392  else
393    Result := false;
394end;
395
396function TMoney.Count: integer;
397begin
398  Result := 1;
399end;
400
401function TMoney._Self: TObject;
402begin
403  Result := Self;
404end;
405
406end.
407