stmoney.pas

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

    Exit;
  end;

  {otherwise the exchange rate is invalid}
end;

function MakeXChgStr(ConversionType : TStConversionType) : AnsiString;
{ convert TStConversionType to string for persistence }
begin
  case ConversionType of
    ctTriangular : Result := 'tri';
    ctMultiply   : Result := 'mul';
    ctDivide     : Result := 'div';
  else
    raise Exception.Create('Unknown conversion type');
  end; { case }
end;

function MakeXChg(const XchStr : AnsiString) : TStConversionType;
{ convert persistence string to TStConversionType }
begin
  if (AnsiCompareText(XchStr, 'mul') = 0) then
    Result := ctMultiply
  else if (AnsiCompareText(XchStr, 'div') = 0) then
    Result := ctDivide
  else if (AnsiCompareText(XchStr, 'tri') = 0) then
    Result := ctTriangular
  else begin
    raise Exception.Create('Unknown conversion type in INI file');
    Result := ctUnknown;
  end;
end;

procedure ReplaceCh(var S : AnsiString; aFromCh : AnsiChar; aToCh : AnsiChar);
var
  i : integer;
begin
  {replace the first occurrence of aFromCh with aToCh in string S}
  for i := 0 to length(S) do
    if (S[i] = aFromCh) then begin
      S[i] := aToCh;
      Exit;
    end;
end;

procedure TStExchangeRate.LoadFromList(List: TStrings);
{
set item properties from Exchange Rate data
expects data in the format:

source=<source currency>
target=<target currency>
intermediate=<intermediate currency>
rate=<exchange rate>
type=<tri|mul|div>
date=<date of setting>
}
var
  Str : AnsiString;
  DayCount : integer;
  ec       : integer;
begin
  if Assigned(List) then begin
    Clear;
    FSource       := List.Values['source'];
    FTarget       := List.Values['target'];
    FIntermediate := List.Values['intermediate'];
    FConversionType := MakeXChg(List.Values['type']);

    Str := List.Values['date'];
    Val(Str, DayCount, ec);
    if (ec <> 0) then
      DayCount := 0;
    FDateUpdated := ExchBaseDate + DayCount;

    Str := List.Values['rate'];
    if Str = '' then
      FRate.SetToOne
    else begin
      {the INI file stores rates with a decimal *point*; if the locale
       uses something else (eg, a comma) we'll need to switch it for
       the AsString property, which obeys the locale}
      if (DecimalSeparator <> '.') then
        ReplaceCh(Str, '.', DecimalSeparator);
      FRate.AsString := Str;
    end;
  end;
end;

function TStExchangeRate.SameSourceAndTarget(
  aRate: TStExchangeRate): Boolean;
{
Tests whether the specified rate has the same source and target currencies.
Returns True of the Source and Target currencies are the same, False otherwise
}
begin
  Result := False;
  if Assigned(aRate) then
    Result := (AnsiCompareText(Source, aRate.Source) = 0) and
              (AnsiCompareText(Target, aRate.Target) = 0);
end;

procedure TStExchangeRate.SaveToList(List: TStrings);
{ create persistent representation of item }
var
  Str : AnsiString;
  DayCount : integer;
begin
  if Assigned(List) then begin
    List.Clear;
    List.Add('source=' + FSource);
    List.Add('target=' + FTarget);
    List.Add('intermediate=' + FIntermediate);
    Str := FRate.AsString;
    if (DecimalSeparator <> '.') then
      ReplaceCh(Str, DecimalSeparator, '.');
    List.Add('rate=' + Str);
    List.Add('type=' + MakeXChgStr(FConversionType));
    DayCount := trunc(FDateUpdated - ExchBaseDate);
    if DayCount < 0 then
      DayCount := 0;
    List.Add('date=' + IntToStr(DayCount));
  end;
end;

procedure TStExchangeRate.SetRate(const Value: TStDecimal);
begin
  FRate.Assign(Value);
end;

procedure TStExchangeRate.Update;
{ fire update event }
var
  NewDate : TDateTime;
begin
  if Assigned(FOnGetRateUpdate) then begin
    NewDate := DateUpdated;
    FOnGetRateUpdate(Self, Rate, NewDate);
    DateUpdated := NewDate;
  end;
end;


{ TStExchangeRateList }
constructor TStExchangeRateList.Create;
begin
  inherited Create;
  FRates := TStringList.Create;
  FRates.Sorted := True;
  FRates.Duplicates := dupIgnore;
end;

destructor TStExchangeRateList.Destroy;
begin
  Clear;
  FRates.Free;
  inherited Destroy;
end;

procedure TStExchangeRateList.Add(ARate: TStExchangeRate);
{
Adds the given exchange rate to the list

Since FRates list is set for dupIgnore, if Rate already exists, the
new values will be discarded

To modify an existing rate, use the Rates property or the UpdateRate
method, or delete the existing Rate and re-add it
}
begin
  if Assigned(ARate) then
    FRates.AddObject(MakeEntry(ARate.Source, ARate.Target), ARate);
end;

procedure TStExchangeRateList.AddByValues(const Source, Target,
  Intermediate : AnsiString; Rate : Double; ConversionType : TStConversionType;
  DateUpdated : TDateTime);
{
Create new rate with provided characteristics and add it to the list

Since FRates list is set for dupIgnore, if Rate already exists, the
new values will be discarded

To modify an existing rate, use the Rates property or the UpdateRate
method, or delete the existing Rate and re-add it
}
var
  TempRate : TStExchangeRate;
begin
  TempRate := TStExchangeRate.Create;
  TempRate.Source := Source;
  TempRate.Target := Target;
  TempRate.Intermediate := Intermediate;
  TempRate.ConversionType := ConversionType;
  TempRate.DateUpdated := DateUpdated;
  TempRate.Rate.AssignFromFloat(Rate);
  Add(TempRate);
end;

procedure TStExchangeRateList.Assign(AList: TStExchangeRateList);
var
  i : Integer;
begin
  if Assigned(AList) then begin
    { if Rate Lists already point to same list then don't do anything }
    if FRates = AList.FRates then Exit;

    { empty list }
    Clear;

    { add items from new list }
    for i := 0 to Pred(AList.Count) do
      Add(AList.Items[i]);
  end;
end;

procedure TStExchangeRateList.Clear;
{ Clears all of the exchange rates from this table. }
var
  i : Integer;
begin
  for i := Pred(FRates.Count) downto 0 do begin
    DeleteRate(i);
  end;
end;

function TStExchangeRateList.Contains(
  ARate: TStExchangeRate): Boolean;
{
Returns true if an exchange rate already exists with this rate's source,
target pair.
}
begin
  Result := False;
  if Assigned(ARate) then
    Result := ContainsByName(ARate.Source, ARate.Target);
end;

function TStExchangeRateList.ContainsByName(const Source,
  Target: AnsiString): Boolean;
{
Returns true if an exchange rate already exists with this one's
source and target ISOName Strings
}
begin
  Result := FRates.IndexOf(MakeEntry(Source, Target)) >= 0;
end;

procedure TStExchangeRateList.Convert(const Source, Target: AnsiString;
  Amount, Result: TStDecimal);
{
convert Amount from Source currency to Target currency,
return new value in Result
}
begin
  {Amount and Result must be created}
  if (Amount = nil) or (Result = nil) then
    raise EStException.CreateResTP(stscMoneyInvalidExchangeParams, 0);

  {set the result value equal to the amount being converted}
  Result.Assign(Amount);

  {convert, allowing triangular exchanges}
  ConvertPrim(Source, Target, Result, true);
end;

procedure TStExchangeRateList.ConvertPrim(const aSource, aTarget : string;
                                                aAmount : TStDecimal;
                                                aAllowTriangular : boolean);
var
  Rate : TStExchangeRate;
begin
  { do we have an entry for a Source->Target conversion? }
  if not ContainsByName(aSource, aTarget) then
    raise EStException.CreateResFmtTP(stscMoneyNoSuchExchange,
                                      [aSource, aTarget], 0);

  {get the exchange rate}
  Rate := Rates[aSource, aTarget];

  {for a simple multiply or divide conversion, the Rate object can
   handle that by itself}
  if (Rate.ConversionType = ctMultiply) or
     (Rate.ConversionType = ctDivide) then begin
    Rate.Convert(aAmount, aAmount);
    Exit;
  end;

  {if a triangular exchange is not allowed, raise an error}
  if not aAllowTriangular then
    raise EStException.CreateResTP(stscMoneyTriExchUsesTriExch, 0);

  {if the exchange rate is not triangular, raise an error}
  if (Rate.ConversionType <> ctTriangular) then
    raise EStException.CreateResTP(stscMoneyInvalidExchangeParams, 0);

  {the conversion is triangular: check the intermediate currency}
  if (Rate.Intermediate = '') then
    raise EStException.CreateResTP(stscMoneyInvalidExchangeParams, 0);

  {check to see if we have the two exchange rates}
  if (not ContainsByName(aSource, Rate.Intermediate)) or
     (not ContainsByName(Rate.Intermediate, aTarget)) then
    raise EStException.CreateResFmtTP(stscMoneyMissingIntermediateRate,
                                      [aSource, aTarget], 0);

  {convert the amount from the Source to the Intermediate currency,
   and then the result from the Intermediate to the Target currency;
   triangular exchanges are *not* allowed to avoid infinite loops}
  ConvertPrim(aSource, Rate.Intermediate, aAmount, false);
  ConvertPrim(Rate.Intermediate, aTarget, aAmount, false);
end;

procedure TStExchangeRateList.Delete(ARate: TStExchangeRate);
{
delete specified rate from list
fails silently if no matching rate exists in list
}
begin
  DeleteByName(ARate.Source, ARate.Target);
end;

procedure TStExchangeRateList.DeleteByName(const Source,
  Target: AnsiString);
{
delete rate from list as determined by Source and Target
fails silently if no matching rate exists in list
}
var
  Idx : Integer;
begin
  { find item in list }
  Idx := FRates.IndexOf(MakeEntry(Source, Target));

  { if it exists, remove it }
  if Idx >= 0 then
    DeleteRate(Idx);
end;

procedure TStExchangeRateList.DeleteRate(Index : Integer);
{ remove Rate from list by index }
{ no error checking that Index is in Range, should be done by caller }
begin
  (FRates.Objects[Index] as TStExchangeRate).Free;
  FRates.Delete(Index);
end;

function TStExchangeRateList.GetCount: Integer;
begin
  Result := FRates.Count;
end;

function TStExchangeRateList.GetItem(Index: Integer): TStExchangeRate;
{ return Exchange rate by index }
begin
  if not ((0 <= Index) and (Index < FRates.Count)) then
    raise EStException.CreateResFmtTP(stscBadIndex, [IntToStr(Index)], 0);
  Result := (FRates.Objects[Index] as TStExchangeRate);
end;

function TStExchangeRateList.GetRate(const Source,
  Target: AnsiString): TStExchangeRate;
{ return Exchange rate by Source and Target }
var
  Idx : Integer;
begin
  Idx := FRates.IndexOf(MakeEntry(Source, Target));
  if Idx >= 0 then begin
    Result := (FRates.Objects[Idx] as TStExchangeRate);
  end
  else
    raise EStException.CreateResFmtTP(stscMoneyNoSuchExchange, [Source, Target], 0);
end;

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

procedure TStExchangeRateList.LoadFromStream(AStream: TStream);
{ build Rate list from stream of Rate data }
var
  i : Integer;
  IniStrm : TStIniStream;
  Entries, Sections : TStringList;
  CurRate : TStExchangeRate;
begin
  IniStrm := nil;
  Entries := nil;
  Sections := nil;
  CurRate := nil;
  try
    IniStrm := TStIniStream.Create(AStream);
    Entries := TStringList.Create;
    Sections := TStringList.Create;
    { create "index" of sections }
    IniStrm.ReadSections(Sections);

    { iterate sections }
    for i := 0 to Pred(Sections.Count) do begin
      { get settings as a list of <Name>=<Value> pairs }
      IniStrm.ReadSectionValues(Sections[i], Entries);

      { build new rate item from settings }
      CurRate := TStExchangeRate.Create;
      CurRate.LoadFromList(Entries);

      { add to list }
      Add(CurRate);
      CurRate := nil;
    end;
  finally
    Sections.Free;
    Entries.Free;
    IniStrm.Free;
    CurRate.Free;
  end;
end;

function TStExchangeRateList.MakeEntry(const Source, Target : AnsiString) : AnsiString;
{ format conversion entry header from Source and Target }
begin
  Result := Source + ':' + Target;
end;

procedure TStExchangeRateList.SaveToFile(const AFileName: TFileName);
var
  FS : TFileStream;
begin
  if not FileExists(AFileName) then begin
    FS := TFileStream.Create(AFileName, fmCreate);
    FS.Free;
  end;

  FS := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyNone);
  try
    SaveToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStExchangeRateList.SaveToStream(AStream: TStream);
{ persist list of Rate data to a stream }
var
  i : Integer;
  IniStrm : TStIniStream;
  Entries : TStringList;
  CurRate : TStExchangeRate;
begin
  IniStrm := nil;
  Entries := nil;
  try
    IniStrm := TStIniStream.Create(AStream);
    Entries := TStringList.Create;
    { for each maintained Rate item }
    for i := 0 to Pred(FRates.Count) do begin

      { get reference to the Rate }
      CurRate := (FRates.Objects[i] as TStExchangeRate);

      { make entries for Rate }
      CurRate.SaveToList(Entries);

      { write entries as a new section to INI stream }
      IniStrm.WriteSection(MakeEntry(CurRate.Source, CurRate.Target),
        Entries);
    end;
  finally
    Entries.Free;
    IniStrm.Free;
  end;
end;

procedure TStExchangeRateList.UpdateRate(const Source,
  Target: AnsiString; Rate: TStDecimal);
{
Modifies the exchange rate specified by the source and target
assumes rate already exists, use Add or AddByValues to add new rates
}
var
  Idx : Integer;
begin
  if not Assigned(Rate) then
    raise EStException.CreateResTP(stscMoneyNilParameter, 0);

  Idx := FRates.IndexOf(MakeEntry(Source, Target));
  if Idx >= 0 then begin { conversion already exists for source and target }
    { update Rate to reflect new rate }
    (FRates.Objects[Idx] as TStExchangeRate).Rate.Assign(Rate);
  end
  { else no such rate }
end;

initialization
  ExchBaseDate := EncodeDate(1980, 1, 1);
end.