stfin.pas

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

{======================  Public Routines  ============================}


function AccruedInterestMaturity(Issue, Maturity : TStDate;
                                 Rate, Par : Extended;
                                 Basis : TStBasis) : Extended;
var
  DCF : Extended;
begin
  If (Rate <= 0.0) or (Par <= 0.0) or (Issue >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Issue, Maturity, Issue, Maturity,
    fqAnnual, Basis);
  Result := Par * Rate * DCF;
end;

{-------------------------------------------------------}

function AccruedInterestPeriodic(Issue, Settlement, Maturity : TStDate;
                                 Rate, Par : Extended;
                                 Frequency : TStFrequency;
                                 Basis : TStBasis) : Extended;
var
  Last : TStDate;
  DCF  : Extended;
begin
  if (Rate <= 0.0) or (Par <= 0.0) or (Issue >= Settlement) then
    RaiseStFinError(stscFinBadArg);
  Last := LastCoupon(Settlement, Maturity, Frequency);
  if (Issue > Last) then
    Last := Issue;
  DCF := DayCountFraction(Last, Settlement, Settlement, Maturity,
    Frequency, Basis);
  Result := Par * Rate * DCF;
end;

{-------------------------------------------------------}

function BondDuration(Settlement,Maturity : TStDate;
                      Rate, Yield : Extended;
                      Frequency : TStFrequency;
                      Basis : TStBasis) : Extended;
var
  B, dB : Extended;
  Yw    : Extended;
begin
  if (Rate < 0.0) or (Yield < 0.0) or (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  Yw := Yield / CouponsPerYear[Frequency];
  B := BondDirtyPrice(Settlement, Maturity, Rate, Yield, 100.0,
         Frequency, Basis);
  if (B <> 0.0) then begin
    dB := BondDirtyPrice(Settlement, Maturity, Rate, Yield + StDelta, 100.0,
      Frequency, Basis) - B;
    Result := -((1.0 + Yw) / B) * (dB / StDelta);
  end else
    Result := 0;
end;

{-------------------------------------------------------}

function BondPrice(Settlement, Maturity : TStDate;
                   Rate, Yield, Redemption : Extended;
                   Frequency : TStFrequency;
                   Basis : TStBasis) : Extended;
var
  B, DCF : Extended;
  Last   : TStDate;
begin
  if (Yield < 0.0) or (Rate < 0.0) or (Redemption <= 0) or
     (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  B := BondDirtyPrice(Settlement, Maturity, Rate, Yield, Redemption,
    Frequency, Basis);
  Last := LastCoupon(Settlement, Maturity, Frequency);
  DCF := DayCountFraction(Last, Settlement, Settlement, Maturity,
    Frequency, Basis);
  Result := B - Redemption * Rate * DCF;
end;

{-------------------------------------------------------}

function CumulativeInterest(Rate : Extended;
                            NPeriods : Integer;
                            PV : Extended;
                            StartPeriod, EndPeriod : Integer;
                            Frequency : TStFrequency;
                            Timing : TStPaymentTime) : Extended;
var
  P, CP : Extended;
begin
  if (Rate <=0.0) or (NPeriods <= 0) or (PV <= 0.0) or (StartPeriod < 1) or
    (EndPeriod < 1) or (StartPeriod > EndPeriod) then
    RaiseStFinError(stscFinBadArg);
  P := Payment(Rate, NPeriods, PV, 0.0, Frequency, Timing);
  CP := CumulativePrincipal(Rate, NPeriods, PV, StartPeriod, EndPeriod,
    Frequency, Timing);
  Result := P * (EndPeriod - (StartPeriod - 1.0)) - CP;
end;

{-------------------------------------------------------}

function CumulativePrincipal(Rate : Extended;
                             NPeriods : Integer;
                             PV : Extended;
                             StartPeriod, EndPeriod : Integer;
                             Frequency : TStFrequency;
                             Timing : TStPaymentTime) : Extended;
var
  P : Extended;
begin
  if (Rate <=0.0) or (NPeriods <= 0) or (PV <= 0.0) or (StartPeriod < 1) or
    (EndPeriod < 1) or (StartPeriod > EndPeriod) then
    RaiseStFinError(stscFinBadArg);
  P := Payment(Rate, NPeriods, PV, 0.0, Frequency, Timing);
  Result := FutureValue(Rate, StartPeriod - 1, P, PV, Frequency, Timing) -
    FutureValue(Rate, EndPeriod, P, PV, Frequency, Timing);
end;

{-------------------------------------------------------}

function DecliningBalance(Cost, Salvage : Extended;
                          Life, Period, Month : Integer) : Extended;
var
  Rate : Extended;
  DPv  : Extended;
  TDPv : Extended;
  I    : Integer;
begin
  if (Cost <= 0.0) or (Cost < Salvage) or (Period < 1) or (Life < 2) or
    (Period > (Life + 1)) then
    RaiseStFinError(stscFinBadArg);
  DPv := 0.0;
  TDPv := 0.0;
  if (Salvage = 0) then                                              
    Salvage := 0.001;                                                
  if (Month = 0) then                                                
    Month := 12;                                                     
  Rate := RoundToDecimal(1.0 - Power(Salvage / Cost, 1.0 / Life), 3, false);
  for I := 1 to Period do begin
    if (I = 1) then
      DPv := (Cost * Rate * Month) / 12.0                   {1st Period}
    else if (I = (Life + 1)) then
      DPv := (Cost - TDPv) * Rate * (12.0 - Month) / 12.0   {Last Period}
    else
      DPv := (Cost - TDPv) * Rate;                          {All the rest}
    TDpv := TDpv + Dpv
  end;
  Result := RoundToDecimal(Dpv, 3, False);
end;

{-------------------------------------------------------}

function DiscountRate(Settlement, Maturity : TStDate;
                      Price, Redemption : Extended;
                      Basis : TStBasis) : Extended;
var
  DCF : Extended;
begin
  If (Price <= 0.0) or (Redemption <= 0.0) or (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, Basis);
  Result := (Redemption - Price) / (Redemption * DCF);
end;

  {-------------------------------------------------------}

function DollarToDecimal(FracDollar : Extended;
                         Fraction : Integer) : Extended;
var
  I, F, N : Extended;
begin
  if (Fraction < 1) then
    RaiseStFinError(stscFinBadArg);
  I := Int(FracDollar);                   {Integral part}
  N := Int(Log10(Fraction) + 1.0);        {Number of decimal places}
  F := Frac(FracDollar);                  {Fractional part}
  Result := I + (F * Exp10(N) / Fraction);
end;

{-------------------------------------------------------}

function DollarToDecimalText(DecDollar : Extended) : string;
var
  A, P  : Extended;
  N, I  : Integer;
  Str   : string;
  T     : Longint;
  CentVal : Integer;                                                 
const
  Orders : array[0..5] of string = ('', 'Thousand ', 'Million ',     
    'Billion ', 'Trillion ', 'Quadrillion ');                        

  function Text100(Num: Longint) : string;
    {formats an integer in the range 0 to 999}
  var
    I, J : Integer;
    A, T : Longint;
    S    : string;
  const
    Tens : array[0..9] of string =
             ('', '', 'Twenty', 'Thirty', 'Forty', 'Fifty',
              'Sixty', 'Seventy', 'Eighty', 'Ninety');
    Ones : array[0..19] of string =
             ('', 'One', 'Two', 'Three', 'Four', 'Five',
              'Six', 'Seven', 'Eight', 'Nine', 'Ten',
              'Eleven', 'Twelve', 'Thirteen', 'Fourteen', 'Fifteen',
              'Sixteen', 'Seventeen', 'Eighteen', 'Nineteen');
  begin
    S := '';
    I := 0;
    J := 0;
    Result := S;
    if (Num = 0) then
      Exit;
    A := Num;
    T := A div 100;
    if (T > 0) then begin
      I := T;                          {I = Hundreds digit}
      A := A - (T * 100);
    end;
    T := A div 10;
    if (T > 1) then begin
      J := T;                          {J = Tens digit}
      A := A - (T * 10);               {A = Ones digit}
    end;
    if (I > 0) then
      S := Ones[I] + ' Hundred';
    if (J > 0) then begin
      if (I > 0) then
        S := S + ' ' + Tens[J]
      else
        S := S + Tens[J];
    end;
    if (A > 0) then begin
      if (J > 0) then
        S := S + '-';
      if (I > 0) and (J = 0) then
        S := S + ' ' + Ones[A]
      else
        S := S + Ones[A];
    end;
    Result := S;
  end;

begin
  Str := '';
  if (DecDollar < 0) then                                            
    RaiseStFinError(stscFinBadArg);                                  
  if (DecDollar > 0) then begin                                      
    N := Trunc(Log10(DecDollar));
    if (N > 17) then  {DecDollar too large}
      RaiseStFinError(stscFinBadArg);
    A := DecDollar;
    for I := N downto 0 do begin
      P := Int(Exp10(I * 3));
      T := Trunc(A / P);
      if (T > 0) then
        Str := Str + {' ' +} Text100(T) + ' ' + Orders[I];
      A := A - (T * P);
    end;
  end;                                                               
  if (Str = '') then                                                 
    Str := 'Zero ';                                                  
  Str := Str + 'and ';                                               
  CentVal := Round(Frac(DecDollar) * 100);                           
  if (CentVal < 10) then                                             
    Str := Str + '0';                                                
  Result := Str + IntToStr(CentVal) + '/100';                        
end;

{-------------------------------------------------------}

function DollarToFraction(DecDollar : Extended;
                          Fraction : Integer) : Extended;
var
  I, F, N : Extended;
begin
  if (Fraction < 1) then
    RaiseStFinError(stscFinBadArg);
  I := Int(DecDollar);                  {Integral part}
  N := Int(Log10(Fraction) + 1.0);      {Number of decimal places}
  F := Frac(DecDollar);                 {Fractional part}
  Result := I + (F * Fraction / Exp10(N));
end;

{-------------------------------------------------------}

function DollarToFractionStr(FracDollar : Extended;
                             Fraction : Integer) : string;
var
  I, F, N : Extended;
begin
  Result := '';
  if (Fraction < 1) then
    RaiseStFinError(stscFinBadArg);
  I := Int(FracDollar);                 {Integral part}
  N := Int(Log10(Fraction) + 1.0);      {Number of decimal places}
  F := Frac(FracDollar) * Exp10(N);     {Fractional part}
  Result := IntToStr(Trunc(I));
  if (F > 0) then
    Result := Result  + ' ' + FloatToStrF(F, ffNumber, Trunc(N), 0) +
      '/' + IntToStr(Fraction);
end;

{-------------------------------------------------------}

function EffectiveInterestRate(NominalRate : Extended;
                               Frequency : TStFrequency) : Extended;
var
  W : Integer;
begin
  if (NominalRate <= 0.0) then
    RaiseStFinError(stscFinBadArg);
  W := CouponsPerYear[Frequency];
  Result := Power(1.0 + NominalRate / W, W) - 1.0;
end;

{-------------------------------------------------------}

function FutureValue(Rate : Extended;
                     NPeriods : Integer;
                     Pmt, PV : Extended;
                     Frequency : TStFrequency;
                     Timing: TStPaymentTime) : Extended;
var
  S, Rw  : Extended;
  PT     : Integer;

begin
  PT := PaymentType[Timing];
  Rw := Rate / CouponsPerYear[Frequency];
  S := Power(1.0 + Rw, NPeriods);
  Result := -((PV * S) + Pmt * (S - 1.0) * (1.0 + Rw * PT) / Rw);
end;

{-------------------------------------------------------}

  function FutureValueSchedule(Principal : Extended;
                               const Schedule : array of Double) : Extended;
  begin
    Result := FutureValueSchedule16(Principal, Schedule,
                                    High(Schedule) + 1);
  end;

function FutureValueSchedule16(Principal : Extended;
  const Schedule; NRates : Integer) : Extended;
var
  I : Integer;
begin
  Result := Principal;
  for I := 0 to (NRates - 1) do
    Result := Result * (1.0 + TDoubleArray(Schedule)[I]);
end;

{-------------------------------------------------------}

function InterestRate(NPeriods : Integer;
                      Pmt, PV, FV : Extended;
                      Frequency : TStFrequency;
                      Timing : TStPaymentTime;
                      Guess : Extended) : Extended;
var
  Rate     : Extended;
  NextRate : Extended;
  T, dT    : Extended;
  Count    : Integer;
begin
  Count := 0;
  NextRate := Guess;
  if (Guess = 0.0) then
    NextRate := DefaultGuess;
    {Solve FV(rate) = FV for rate by Newton's method}
  repeat
    Rate := NextRate;
    if (Rate <= - CouponsPerYear[Frequency]) then                    
      Rate := -0.999 * CouponsPerYear[Frequency];                    
     T := FutureValue(Rate, NPeriods, Pmt, PV, Frequency, Timing) - FV;
    dT := FutureValue(Rate + StDelta, NPeriods, Pmt, PV, Frequency,
      Timing) - FV - T;
    if (dT = 0.0) then
      Count := StMaxIterations
    else
      NextRate := Rate - StDelta * T / dT;
    Inc(Count);
  until (Abs(NextRate - Rate) < StEpsilon) or (Count > StMaxIterations);
  if (Count > StMaxIterations) then
    RaiseStFinError(stscFinNoConverge);
  Result := NextRate;
end;

{-------------------------------------------------------}

  function InternalRateOfReturn(const Values : array of Double;
                                Guess : Extended) : Extended;
  begin
    Result := InternalRateOfReturn16(Values, High(Values) + 1, Guess);
  end;

function InternalRateOfReturn16(const Values;
                                NValues : Integer;
                                Guess : Extended) : Extended;
var
  Rate     : Extended;
  NextRate : Extended;
  PV       : Extended;
  dPV      : Extended;
  Count    : Integer;
begin
  Count := 0;
  NextRate := Guess;
  if (Guess = 0.0) then
    NextRate := DefaultGuess;
    {Solve NPV(Rate) = 0 for rate by Newton's method}
  repeat
    Rate := NextRate;
    if (Rate <= -1.0) then                                           
      Rate := -0.999;                                                
    PV := NetPresentValue16(Rate, Values, NValues);
    dPV := NetPresentValue16(Rate + StDelta, Values, NValues) - PV;
    if (dPV = 0.0) then
      Count := StMaxIterations
    else
      NextRate := Rate - (StDelta * PV) / dPV;
    Inc(Count);
  until (Abs(NextRate - Rate) < StEpsilon) or (Count > StMaxIterations);
  if (Count > StMaxIterations) then
    RaiseStFinError(stscFinNoConverge);
  Result := NextRate;
end;