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