stmoney.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StMoney.pas 4.03                            *}
{*********************************************************}
{* SysTools: Currency and Money Related Classes          *}
{*********************************************************}

{$include StDefine.inc}

unit StMoney;

interface

uses
  Windows, SysUtils, Classes,

  StConst, StBase, StStrms, StDecMth, StIniStm;


type
{
; Layout of currency entries
[ISOCode]
Name=Country-Currency Name
ISOName=<ISO 4217 3 Letter Currency ID>
ISOCode=<ISO 4217 3 Digit Currency Number>
UnitMajor=<Major Currency Name>
UnitMinor=<Minor Currency Name>
Ratio=<ratio of minor currency to major>
}

  TStCurrency = class(TObject)
  { representation of a national currency, based on ISO 4217 specification }
  private
    FName: AnsiString;
    FISOCode: AnsiString;
    FISOName: AnsiString;
    FRatio: Integer;
    FUnitMajor: AnsiString;
    FUnitMinor: AnsiString;

  public
    { Persistence and streaming methods }
    procedure LoadFromList(List : TStrings);
    procedure SaveToList(List : TStrings);

    { properties }
    property ISOCode: AnsiString
      read FISOCode write FISOCode;
    property ISOName: AnsiString
      read FISOName write FISOName;
    property Name: AnsiString
      read FName write FName;
    property Ratio: Integer
      read FRatio write FRatio;
    property UnitMajor: AnsiString
      read FUnitMajor write FUnitMajor;
    property UnitMinor: AnsiString
      read FUnitMinor write FUnitMinor;
  end;

  TStCurrencyList = class (TObject)
  { collection of national currencies }
  private
    FItems: TStringList;
  protected {private}
    function GetCount: Integer;
    function GetCurrency(const ISOName : AnsiString): TStCurrency;
    function GetItem(Index : Integer): TStCurrency;
    procedure SetCurrency(const ISOName : AnsiString; Value: TStCurrency);
    procedure SetItem(Index : Integer; Value: TStCurrency);

    procedure FreeCurrencyByIndex(Index : Integer);
  public
    constructor Create;
    destructor Destroy; override;

    { Access and Update Methods }
    procedure Add(ACurrency : TStCurrency);
    procedure Clear;
    function Contains(ACurrency : TStCurrency): Boolean;
    function ContainsName(const ISOName : AnsiString): Boolean;
    procedure Delete(const ISOName: AnsiString);
    function IndexOf(const ISOName : AnsiString) : Integer;

    { Persistence and streaming methods }
    procedure LoadFromFile(const AFileName: TFileName);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToFile(const AFileName: TFileName);
    procedure SaveToStream(AStream: TStream);

    { properties }
    property Count : Integer
      read GetCount;
    property Currencies[const ISOName : AnsiString]: TStCurrency
      read GetCurrency write SetCurrency;
    property Items[Index : Integer] : TStCurrency
      read GetItem write SetItem; default;
  end;


{
Conversion  Methods
===================
When converting money of one currency into money of another currency, three
conversion methods are commonly encountered:

1)
"Triangular": the source currency amount is converted to an intermediate
currency amount, then the intermediate currency amount is converted to
the target amount.

Note: This is the method required by members of the European Monetary
Union (EMU), for converting among national currencies that are transitioning
to the Euro; the Euro should be used as the Intermediate currency for such
conversions.

2)
"Multiply" the source currency amount is multiplied by a conversion Rate
to obtain the target currency amount.

3)
"Divide" the source currency amount is divided by a conversion Rate to
obtain the target currency amount.
}
  TStConversionType = (ctUnknown, ctTriangular, ctMultiply, ctDivide);

  TStGetRateUpdateEvent = procedure (Sender: TObject; NewRate : TStDecimal;
    var NewDate : TDateTime) of object;
{
; Layout of exchange entries
[SRC:TRG]
source=SRC
target=TRG
; empty/ignored if not a triangular exchange
intermediate=XXX
rate=xxx
; error if tri and intermediate not set
type=<tri|mul|div>
date=<date>
}

  TStExchangeRate = class (TObject)
  { particular Exchange Rate between two currencies }
  private
    FRate: TStDecimal;
    FSource: AnsiString;
    FTarget : AnsiString;
    FIntermediate : AnsiString;
    FConversionType : TStConversionType;
    FDateUpdated      : TDateTime;
    FOnGetRateUpdate: TStGetRateUpdateEvent;
    procedure SetRate(const Value: TStDecimal);
  public
    constructor Create;
    destructor Destroy; override;

    { Access and Update Methods }
    procedure Assign(ARate : TStExchangeRate);
    procedure Clear;
    procedure Convert(Amount, Result: TStDecimal);
    function Equals(aRate : TStExchangeRate) : Boolean;
    function IsValid : Boolean;
    function SameSourceAndTarget(aRate : TStExchangeRate) : Boolean;
    procedure Update;

    { Persistence and streaming methods }
    procedure LoadFromList(List : TStrings);
    procedure SaveToList(List : TStrings);

    { properties }
    property ConversionType : TStConversionType
      read FConversionType write FConversionType;
    property DateUpdated : TDateTime
      read FDateUpdated write FDateUpdated;
    property Intermediate : AnsiString
      read FIntermediate write FIntermediate;
    property Rate : TStDecimal
      read FRate write SetRate;
    property Source : AnsiString
      read FSource write FSource;
    property Target : AnsiString
      read FTarget write FTarget;

    { events }
    property OnGetRateUpdate : TStGetRateUpdateEvent
      read FOnGetRateUpdate write FOnGetRateUpdate;
  end;

  TStExchangeRateList = class (TObject)
  { collection of currency conversions (TStExchangeRate) }
  private
    FRates : TStringList;
  protected {private}
    procedure DeleteRate(Index: Integer);
    function GetCount: Integer;
    function GetRate(const Source, Target: AnsiString): TStExchangeRate;
    function GetItem(Index: Integer): TStExchangeRate;
    function MakeEntry(const Source, Target: AnsiString): AnsiString; virtual;

    procedure ConvertPrim(const aSource, aTarget : string;
                                aAmount : TStDecimal;
                                aAllowTriangular : boolean);
  public
    constructor Create;
    destructor Destroy; override;

    { Access and Update Methods }
    procedure Add(ARate : TStExchangeRate);
    procedure AddByValues(const Source, Target, Intermediate: AnsiString;
      Rate: Double; ConversionType: TStConversionType; DateUpdated: TDateTime);
    procedure Assign(AList : TStExchangeRateList);
    procedure Clear;
    function Contains(ARate : TStExchangeRate) : Boolean;
    function ContainsByName(const Source, Target : AnsiString) : Boolean;
    procedure Convert(const Source, Target : AnsiString;
      Amount, Result : TStDecimal);
    procedure Delete(ARate : TStExchangeRate);
    procedure DeleteByName(const Source, Target : AnsiString);
    procedure UpdateRate(const Source, Target : AnsiString; Rate : TStDecimal);

    { Persistence and streaming methods }
    procedure LoadFromFile(const AFileName: TFileName);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToFile(const AFileName: TFileName);
    procedure SaveToStream(AStream: TStream);

    { properties }
    property Count : Integer
      read GetCount;
      { Returns the number of exchange rates in this table. }
    property Items[Index : Integer] : TStExchangeRate
      read GetItem;
      { access to all of the exchange rates in the collection by numeric index }
    property Rates[const Source, Target : AnsiString] : TStExchangeRate
      read GetRate;
      { access to all of the exchange rates in the collection by Source and Target }
  end;

  TStMoney = class (TObject)
  { representation of an amount of Currency and operations on same }
  private
    FAmount : TStDecimal;
    FCurrency : AnsiString;
    FExchangeRates : TStExchangeRateList;

    function GetAsFloat: Double;
    function GetAsString: AnsiString;
    procedure SetAmount(const Value: TStDecimal);
    procedure SetAsFloat(const Value: Double);
    procedure SetAsString(const Value: AnsiString);
    procedure Validate(Source, Operand, Result: TStMoney);
    function ValidateCurrencies(Source, Dest: TStMoney) : Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(AMoney : TStMoney);

    { basic math operations }
    procedure Abs(Result : TStMoney);
    procedure Add(Addend, Sum : TStMoney);
    procedure Divide(Divisor : Double; Quotient : TStMoney);
    procedure DivideByDecimal(Divisor : TStDecimal; Quotient : TStMoney);
    procedure Multiply(Multiplier : Double; Product : TStMoney);
    procedure MultiplyByDecimal(Multiplier : TStDecimal; Product : TStMoney);
    procedure Negate(Result : TStMoney);
    procedure Subtract(Subtrahend, Remainder : TStMoney);

    { logical comparisons }
    function Compare(CompareTo : TStMoney): Integer;
    function IsEqual(AMoney : TStMoney): Boolean;
    function IsGreaterThan(AMoney : TStMoney): Boolean;
    function IsGreaterThanOrEqual(AMoney : TStMoney): Boolean;
    function IsLessThan(AMoney : TStMoney): Boolean;
    function IsLessThanOrEqual(AMoney : TStMoney): Boolean;
    function IsNegative: Boolean;
    function IsNotEqual(AMoney : TStMoney): Boolean;
    function IsPositive: Boolean;
    function IsZero: Boolean;

    { Conversion Methods }
    procedure Convert(const Target : AnsiString; Result : TStMoney);
    procedure Round(Method : TStRoundMethod;  Decimals : Integer; Result : TStMoney);
    { See definition of TStRoundMethod in the StDecMth unit for more
      information on rounding }

    { properties }
    property Amount: TStDecimal
      read FAmount write SetAmount;
    property AsFloat: Double
      read GetAsFloat write SetAsFloat;
    property AsString: AnsiString
      read GetAsString write SetAsString;
    property Currency: AnsiString
      read FCurrency write FCurrency;
    property ExchangeRates : TStExchangeRateList
      read FExchangeRates write FExchangeRates;
  end;

implementation

var
  ExchBaseDate : TDateTime; // the base date for exchange rates

{ TStCurrency }

procedure TStCurrency.LoadFromList(List : TStrings);
{
assign currency properties from a set of <Name>=<Value> pairs

BuildItem expects data in the form:

Name=Country-Currency Name
ISOName=<ISO 4217 3 Letter Currency ID>
ISOCode=<ISO 4217 3 Digit Currency Number>
UnitMajor=<Major Currency Name>
UnitMinor=<Minor Currency Name>
Ratio=<ratio of minor currency to major>
}
begin
  if Assigned(List) then begin
    FName      := List.Values['Name'];
    FISOCode   := List.Values['ISOCode'];
    FISOName   := List.Values['ISOName'];
    FUnitMajor := List.Values['UnitMajor'];
    FUnitMinor := List.Values['UnitMinor'];
    FRatio     := StrToIntDef(List.Values['Ratio'], 100);
  end;
end;

procedure TStCurrency.SaveToList(List : TStrings);
{ write Currency data to <Name>=<Value> pairs for persistence }
begin
  if Assigned(List) then begin
    List.Clear;
    List.Add('Name=' + FName);
    List.Add('ISOCode=' + FISOCode);
    List.Add('ISOName=' + FISOName);
    List.Add('UnitMajor=' + FUnitMajor);
    List.Add('UnitMinor=' + FUnitMinor);
    List.Add('Ratio=' +   IntToStr(FRatio));
  end;
end;

{ TStCurrencyList }

constructor TStCurrencyList.Create;
begin
  inherited Create;
  FItems := TStringList.Create;
  FItems.Sorted := True;
  FItems.Duplicates := dupIgnore;
end;

destructor TStCurrencyList.Destroy;
begin
  Clear;
  FItems.Free;
  inherited Destroy;
end;

procedure TStCurrencyList.Add(ACurrency: TStCurrency);
{ add a new currency to the list }
begin
  if Assigned(ACurrency) then
    FItems.AddObject(ACurrency.ISOName, ACurrency);
end;

procedure TStCurrencyList.Clear;
{ Clear the list of currencies }
var
  i: Integer;
begin
  for i := Pred(FItems.Count) downto 0 do
    FreeCurrencyByIndex(i);
end;

function TStCurrencyList.Contains(ACurrency: TStCurrency): Boolean;
{ returns true if there's an entry for such a currency }
begin
  Result := False;
  if Assigned(ACurrency) then
    Result := FItems.IndexOf(ACurrency.ISOName) >= 0;
end;

function TStCurrencyList.ContainsName(const ISOName: AnsiString): Boolean;
{ returns true if there's an entry for such a currency ID }
begin
  Result := FItems.IndexOf(ISOName) >= 0;
end;

procedure TStCurrencyList.Delete(const ISOName: AnsiString);
{ delete the requested currency from the list }
begin
  FreeCurrencyByIndex(FItems.IndexOf(ISOName));
end;

procedure TStCurrencyList.FreeCurrencyByIndex(Index: Integer);
{ release a currency by the requested numeric index in the list }
begin
  { if index in range }
  if (0 <= Index) and (Index < FItems.Count) then begin
    { free StCurrency data at that index }
    (FItems.Objects[Index] as TStCurrency).Free;
    { delete item from list }
    FItems.Delete(Index);
  end;
  { else, item doesn't exist, so do nothing }
end;

function TStCurrencyList.GetCount : Integer;
{ just return count of maintained items }
begin
  Result := FItems.Count;
end;

function TStCurrencyList.GetCurrency(const ISOName: AnsiString): TStCurrency;
{
return reference to requested currency item indexed by ISOName
returns nil if item doesn't exist
}
var
  Index : Integer;
begin
  { find index of item }
  Index := FItems.IndexOf(ISOName);
  { return item as a TStCurrency reference, or nil if it wasn't found }
  if (Index >= 0) then
    Result := GetItem(Index)
  else
    Result := nil;
end;

function TStCurrencyList.GetItem(Index : Integer): TStCurrency;
{
return reference to requested currency item indexed by position in list
returns nil if item doesn't exist
}
begin
  if not ((0 <= Index) and (Index < FItems.Count)) then
    raise EStException.CreateResFmtTP(stscBadIndex, [IntToStr(Index)], 0);

  Result := (FItems.Objects[Index] as TStCurrency);
end;

function TStCurrencyList.IndexOf(const ISOName: AnsiString): Integer;
{
locate index of requested item in list,
returns -1 if item doesn't exist
}
begin
  Result := FItems.IndexOf(ISOName);
end;

procedure TStCurrencyList.LoadFromFile(const AFileName: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStCurrencyList.LoadFromStream(AStream : TStream);
var
  IniStr : TStIniStream;
  Currencies, Section : TStrings;
  ACurrency : TStCurrency;
  i : Integer;
begin
  {clear out the current currency items}
  Clear;

  IniStr := nil;
  Currencies := nil;
  Section := nil;
  ACurrency := nil;
  try
    IniStr := TStIniStream.Create(AStream);
    Currencies := TStringList.Create;
    Section := TStringList.Create;