stmoney.pas

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

    { create an "index" of the sections }
    IniStr.ReadSections(Currencies);

    { read a currency definition }
    for i := 0 to Pred(Currencies.Count) do begin
      { get settings as .INI style items }
      IniStr.ReadSectionValues(Currencies[i], Section);

      { create a new currency item }
      ACurrency := TStCurrency.Create;

      { set its properties }
      ACurrency.LoadFromList(Section);

      { add it to the list }
      FItems.AddObject(ACurrency.ISOName, ACurrency);
      ACurrency := nil;
    end;
  finally
    IniStr.Free;
    Section.Free;
    Currencies.Free;
    // note: this only does something if either the LoadFromList or
    //       AddObject calls failed
    ACurrency.Free;
  end;
end;

procedure TStCurrencyList.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 TStCurrencyList.SaveToStream(AStream : TStream);
var
  IniStr : TStIniStream;
  Strs   : TStringList;
  i : Integer;
begin
  IniStr := nil;
  Strs := nil;
  try
    IniStr := TStIniStream.Create(AStream);
    Strs := TStringList.Create;
    for i := 0 to Pred(FItems.Count) do begin
      { clear the string list to contain the ccy definition }
      Strs.Clear;
      { get item properties as string list }
      (FItems.Objects[i] as TStCurrency).SaveToList(Strs);
      { add new section to .INI data }
      IniStr.WriteSection(FItems[i], Strs);
    end;
  finally
    Strs.Free;
    IniStr.Free;
  end;
end;

procedure TStCurrencyList.SetCurrency(const ISOName: AnsiString;
  Value: TStCurrency);
var
  Idx : Integer;
begin
  { locate item }
  Idx := FItems.IndexOf(ISOName);
  if (Idx >= 0) then
    SetItem(Idx, Value);
end;

procedure TStCurrencyList.SetItem(Index : Integer;
  Value: TStCurrency);
begin
  if not ((0 <= Index) and (Index < FItems.Count)) then
    raise EStException.CreateResFmtTP(stscBadIndex, [IntToStr(Index)], 0);

  if Assigned(Value) then begin
    { release current currency info }
    (FItems.Objects[Index] as TStCurrency).Free;
    { replace with new info }
    FItems.Objects[Index] := Value;
  end;
end;


{ TStMoney }

constructor TStMoney.Create;
begin
  inherited Create;
  FAmount := TStDecimal.Create;
end;

destructor TStMoney.Destroy;
begin
  FAmount.Free;
  inherited Destroy;
end;

procedure TStMoney.Abs(Result : TStMoney);
{ Returns a new money which has the absolute value of this money's amount. }
begin
  Result.Assign(Self);
  Result.Amount.Abs;
end;

procedure TStMoney.Add(Addend, Sum : TStMoney);
begin
  Validate(Self, Addend, Sum);
  Sum.Assign(Self);
  Sum.Amount.Add(Addend.Amount);
end;

procedure TStMoney.Assign(AMoney : TStMoney);
begin
  if Assigned(AMoney) then begin
    Amount.Assign(AMoney.Amount);
    Currency := AMoney.Currency;
    ExchangeRates := AMoney.ExchangeRates;
  end;
end;

function TStMoney.Compare(CompareTo : TStMoney): Integer;
{
Compares this money to the specified money.

Returns <0 if this money is less than the other money, 0 if they are equal,
and >0 if it is greater

Note: Currencies must also be the same
}
begin
  Validate(Self, CompareTo, Self);
  Result := Amount.Compare(CompareTo.Amount);
end;

procedure TStMoney.Convert(const Target : AnsiString; Result : TStMoney);
{
Converts the value to a different currency, utilizes TStExchangeRateList
}
begin
  { check that exchange rates are available }
  if not Assigned(ExchangeRates) then
    raise EStException.CreateResTP(stscMoneyNoExchangeRatesAvail, 0);

  { check validity of operands and result }
  if not Assigned(Result) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  Result.Assign(Self);
  ExchangeRates.Convert(Currency, Target, Amount, Result.Amount);
end;

procedure TStMoney.DivideByDecimal(Divisor : TStDecimal; Quotient : TStMoney);
{ Returns a new money which is the quotient of the money divided by
the decimal divisor. }
begin
  if not Assigned(Divisor) then
    raise EStException.CreateResTP(stscMoneyNilParameter, 0);

  if not Assigned(Quotient) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  Quotient.Assign(Self);
  Quotient.Amount.Divide(Divisor);
end;

procedure TStMoney.Divide(Divisor : Double; Quotient : TStMoney);
{ Returns a new money which is the quotient of the money divided by
the floating point divisor. }
var
  DecDiv : TStDecimal;
begin
  DecDiv := TStDecimal.Create;
  try
    DecDiv.AssignFromFloat(Divisor);
    DivideByDecimal(DecDiv, Quotient);
  finally
    DecDiv.Free;
  end;
end;

function TStMoney.GetAsFloat: Double;
{ return money amount as a Floating point value }
begin
  Result := Amount.AsFloat;
end;

function TStMoney.GetAsString: AnsiString;
{ return money amount as a string }
begin
  Result := Amount.AsString;
end;

function TStMoney.IsEqual(AMoney : TStMoney): Boolean;
{ Returns true if this money and the specified money are equal }
begin
  Result := Compare(AMoney) = 0;
end;

function TStMoney.IsGreaterThan(AMoney : TStMoney): Boolean;
{ Returns true if this money's amount is greater than that of the specified money. }
begin
  Result := Compare(AMoney) > 0;
end;

function TStMoney.IsGreaterThanOrEqual(AMoney : TStMoney): Boolean;
{ Returns true if this money's amount is greater than or equal to the specified money. }
begin
  Result := Compare(AMoney) >= 0;
end;

function TStMoney.IsPositive : Boolean;
{ Returns true if this money's amount is greater than zero. }
begin
  Result := Amount.IsPositive;
end;

function TStMoney.IsZero: Boolean;
{ Returns true if this money's amount is equal to zero. }
begin
  Result := Amount.IsZero;
end;

function TStMoney.IsLessThan(AMoney : TStMoney): Boolean;
{ Returns true if this money's amount is less than that of the specified money. }
begin
  Result := Compare(AMoney) < 0;
end;

function TStMoney.IsLessThanOrEqual(AMoney : TStMoney): Boolean;
{ Returns true if this money's amount is less than or equal to that of the specified money. }
begin
  Result := Compare(AMoney) <= 0;
end;

function TStMoney.IsNegative: Boolean;
{ Returns true if this money's amount is less than zero. }
begin
  Result := Amount.IsNegative;
end;

function TStMoney.IsNotEqual(AMoney : TStMoney): Boolean;
{ Returns true if this money and the specified money are not equal }
begin
  Result := Compare(AMoney) <> 0;
end;

procedure TStMoney.MultiplyByDecimal(Multiplier : TStDecimal;
  Product : TStMoney);
{ Returns a new money which is the product of the money and the decimal value. }
begin
  if not Assigned(Multiplier) then
    raise EStException.CreateResTP(stscMoneyNilParameter, 0);

  if not Assigned(Product) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  Product.Assign(Self);
  Product.Amount.Multiply(Multiplier);
end;

procedure TStMoney.Multiply(Multiplier : Double; Product : TStMoney);
{ Returns a new money which is the product of the money and the floating point value. }
var
  MulDec : TStDecimal;
begin
  MulDec := TStDecimal.Create;
  try
    MulDec.AssignFromFloat(Multiplier);
    MultiplyByDecimal(MulDec, Product);
  finally
    MulDec.Free;
  end;
end;

procedure TStMoney.Negate(Result : TStMoney);
{ Returns a new money which is the negation of this money's amount. }
begin
  if not Assigned(Result) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  Result.Assign(Self);
  Result.Amount.ChangeSign;
end;

procedure TStMoney.Round(Method : TStRoundMethod; Decimals : Integer; Result : TStMoney);
{
Returns a new money with the rounded value of this money using the specified accuracy.
and using the specified rounding method

See definition of TStRoundMethod in the StDecMth unit for more
information on rounding
}
begin
  if not Assigned(Result) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  Result.Assign(Self);
  Result.Amount.Round(Method, Decimals);
end;

procedure TStMoney.SetAmount(const Value: TStDecimal);
begin
  Amount.Assign(Value);
end;

procedure TStMoney.SetAsFloat(const Value: Double);
begin
  Amount.AssignFromFloat(Value);
end;

procedure TStMoney.SetAsString(const Value: AnsiString);
begin
  Amount.AsString := Value;
end;

procedure TStMoney.Subtract(Subtrahend, Remainder : TStMoney);
{ Returns a new money which is the difference between this money and the given money. }
begin
  Validate(Self, Subtrahend, Remainder);
  Remainder.Assign(Self);
  Remainder.Amount.Subtract(Subtrahend.Amount);
end;

function TStMoney.ValidateCurrencies(Source, Dest : TStMoney) : Boolean;
begin
  Result := Source.Currency = Dest.Currency;
end;

procedure TStMoney.Validate(Source, Operand, Result : TStMoney);
begin
  { check validity of operands and result }
  if not Assigned(Source) or not Assigned(Operand) then
    raise EStException.CreateResTP(stscMoneyNilParameter, 0);

  if not Assigned(Result) then
    raise EStException.CreateResTP(stscMoneyNilResult, 0);

  if not ValidateCurrencies(Source, Operand) then
    raise EStException.CreateResTP(stscMoneyCurrenciesNotMatch, 0);
end;

{ TStExchangeRate }

constructor TStExchangeRate.Create;
begin
  inherited Create;
  FRate := TStDecimal.Create;
  Clear;
end;

destructor TStExchangeRate.Destroy;
begin
  FRate.Free;
  inherited Destroy;
end;

procedure TStExchangeRate.Assign(ARate: TStExchangeRate);
begin
  if Assigned(ARate) then begin
    Source := ARate.Source;
    Target := ARate.Target;
    Intermediate := ARate.Intermediate;
    ConversionType := ARate.ConversionType;
    DateUpdated := ARate.DateUpdated;
    Rate.Assign(ARate.Rate);
  end else
  begin
    Clear;
  end;
end;

procedure TStExchangeRate.Clear;
{ clear item fields }
begin
  FSource := '';
  FTarget := '';
  FIntermediate := '';
  FConversionType := ctMultiply;
  FDateUpdated := ExchBaseDate;
  FRate.SetToOne;
end;

procedure TStExchangeRate.Convert(Amount, Result: TStDecimal);
{ convert supplied amount using current ConversionType and Exchange Rate }
begin
  {the parameters must be present}
  if not Assigned(Amount) or not Assigned(Result) then
    raise EStException.CreateResTP(stscMoneyNilParameter, 0);

  {the exchange rate must be valid}
  if not IsValid then
    raise EStException.CreateResTP(stscMoneyInvalidExchRate, 0);

  {set the result equal to the amount prior to converting it}
  Result.Assign(Amount);

  case ConversionType of
    { multiplication conversion }
    ctMultiply   :
      begin
        Result.Multiply(Rate);
      end;

    { division conversion }
    ctDivide     :
      begin
        Result.Divide(Rate);
      end;

    { triangular conversion }
    ctTriangular   :
      begin
        {this can't be done by a single exchange rate}
        raise EStException.CreateResTP(stscMoneyInvalidTriangleExchange, 0);
      end;

  else
    raise EStException.CreateResTP(stscMoneyInvalidExchangeParams, 0);
  end; { case }
end;

function TStExchangeRate.Equals(aRate: TStExchangeRate): Boolean;
{
Returns true if this exchange rate and specified exchange rate have
identical Exchange types, Source currencies, Target currencies,
and conversion Rates or are both Triangular exchanges with the same
Source, Target, and Intermediate currencies
}
var
  CurrenciesMatch, TypesMatch : Boolean;
begin
  Result := False;
  if not Assigned(aRate) then Exit;

  { check if currencies match }
  CurrenciesMatch := (AnsiCompareText(Source, aRate.Source) = 0) and
                     (AnsiCompareText(Target, aRate.Target) = 0);

  { check if exchange types match }
  TypesMatch := (ConversionType = aRate.ConversionType);

  if TypesMatch and CurrenciesMatch then
    case ConversionType of
      ctTriangular : { both triangular }
        { equal if same intermediate currency }
        Result := (FIntermediate = aRate.FIntermediate);

      ctMultiply,
      ctDivide     : { both multiply or divide }
        { equal if same conversion rate }
        Result := (Rate.Compare(aRate.Rate) = 0);
    else
      raise EStException.CreateResTP(stscMoneyInvalidExchangeParams, 0);
    end; { case }
end;

function TStExchangeRate.IsValid: Boolean;
{
Checks to see if this exchange rate has its source, target and Rate
fields set to non-default values, or if a Triangular exchange, that
the intermediate currency is set
}
begin
  {assume the exchange rate is invalid}
  Result := false;

  {the source cannot be empty}
  if (Source = '') then
    Exit;

  {the target cannot be empty}
  if (Target = '') then
    Exit;

  {the source and target must be different}
  if (AnsiCompareText(Source, Target) = 0) then
    Exit;

  {for a multiply/divide conversion, the rate must be > 0.0}
  if (ConversionType = ctMultiply) or (ConversionType = ctDivide) then begin
    Result := FRate.IsPositive;
    Exit;
  end;

  {for a triangular conversion, the intermediate currency must be set
   and cannot be equal to either Source or Target to avoid infinite
   loops in TStExchangeList.Convert <g>}
  if (ConversionType = ctTriangular) then begin
    if (Intermediate = '') then
      Exit;
    if (AnsiCompareText(Source, Intermediate) = 0) then
      Exit;
    if (AnsiCompareText(Target, Intermediate) = 0) then
      Exit;
    Result := true;