stfin.pas

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

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

function IsCardValid(const S : string) : Boolean;
const
  Ord0 = Ord('0');
var
  Temp    : string;
  I, J, K : Integer;
begin
  Result := False;
  Temp := '';
  for I := 1 to Length(S) do
    if (S[I] in ['0'..'9']) then
      Temp := Temp + S[I];
  if Temp = '' then
    Exit;
  K := 0;
  I := 1;
  if not Odd(Length(Temp)) then begin
    J := Ord(Temp[I]) - Ord0;
    J := J shl 1;
    if J > 9 then
      J := J - 9;
    K := K + J;
    Inc(I);
  end;
  while I <= Length(Temp) do begin
    K := K + Ord(Temp[I]) - Ord0;
    Inc(I);
    if I > Length(Temp) then
      Break;
    J := Ord(Temp[I]) - Ord0;
    J := J shl 1;
    if J > 9 then
      J := J - 9;
    K := K + J;
    Inc(I);
  end;
  Result := (K mod 10 = 0);
end;

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

function ModifiedDuration(Settlement, Maturity : TStDate;
                          Rate, Yield : Extended;
                          Frequency : TStFrequency;
                          Basis : TStBasis) : Extended;
begin
  if (Rate < 0.0) or (Yield < 0.0) or (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  Result := BondDuration(Settlement, Maturity, Rate, Yield,
    Frequency, Basis)/ (1.0 + Yield / CouponsPerYear[Frequency]);
end;

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

  function ModifiedIRR(const Values : array of Double;
                       FinanceRate, ReinvestRate : Extended) : Extended;
  begin
    Result := ModifiedIRR16(Values, High(Values) + 1, FinanceRate,
                            ReinvestRate);
  end;

function ModifiedIRR16(const Values;
                       NValues : Integer;
                       FinanceRate, ReinvestRate : Extended) : Extended;
var
  NPVPos : Extended;
  NPVNeg : Extended;
  Val    : Extended;
  Rn, Fn : Extended;
  I      : Integer;
begin
  NPVPos := 0.0;
  NPVNeg := 0.0;
  for I := 0 to (NValues - 1) do begin
    Val := TDoubleArray(Values)[I];
    if (Val > 0.0) then
      NPVPos := NPVPos + Val / Power(1.0 + ReinvestRate, I + 1.0)
    else
      NPVNeg := NPVNeg + Val / Power(1.0 + FinanceRate, I + 1.0);
  end;
  Rn := Power(1.0 + ReInvestRate, NValues);
  Fn := 1.0 + FinanceRate;
  Result := Power(-NPVPos * Rn / (NPVNeg * Fn), 1.0 / (NValues - 1.0)) - 1.0;
end;

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

  function NetPresentValue(Rate : Extended;
                           const Values : array of Double) : Extended;
  begin
    Result := NetPresentValue16(Rate, Values, High(Values) + 1);
  end;

function NetPresentValue16(Rate : Extended;
                           const Values;
                           NValues : Integer) : Extended;
var
  I : Integer;
begin
  Result := 0;
  for I := 0 to (NValues - 1) do
    Result := Result + TDoubleArray(Values)[I] / Power(1.0 + Rate, I + 1.0);
end;

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

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

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

  function NonperiodicIRR(const Values : array of Double;
                          const Dates : array of TStDate;
                          Guess : Extended) : Extended;
  begin
    Result := NonPeriodicIRR16(Values, Dates, High(Values) + 1, Guess);
  end;

function NonperiodicIRR16(const Values;
                          const Dates;
                          NValues : Integer;
                          Guess : Extended) : Extended;
var
  Rate     : Extended;
  NextRate : Extended;
  PV, dPV  : Extended;
  Count    : Integer;
begin
  Count := 0;
  NextRate := Guess;
  if (Guess = 0.0) then
    NextRate := DefaultGuess;
    {Solve XNPV(Rate) = 0 for rate by Newton's method}
  repeat
    Rate := NextRate;
    if (Rate <= -1.0) then                                           
      Rate := -0.999;                                                
    PV := NonPeriodicNPV16(Rate, Values, Dates, NValues);
    dPV := NonPeriodicNPV16(Rate + StDelta, Values, Dates, 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;

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

  function NonperiodicNPV(Rate : Extended;
                          const Values : array of Double;
                          const Dates : array of TStDate) : Extended;
  begin
    Result := NonperiodicNPV16(Rate, Values, Dates, High(Values) + 1);
  end;

function NonperiodicNPV16(Rate : Extended;
                          const Values;
                          const Dates;
                          NValues : Integer) : Extended;
var
  Day1 : TStDate;
  Diff : Double;
  I    : Integer;
begin
  Result := 0.0;
  Day1 := TStDateArray(Dates)[0];
  for I := 0 to (NValues - 1) do begin
    Diff := TStDateArray(Dates)[I] - Day1;
    if (Diff < 0) then
      RaiseStFinError(stscFinBadArg);
    Result := Result + TDoubleArray(Values)[I] / Power(1.0 + Rate, Diff / 365.0);
  end;
end;

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

function Payment(Rate : Extended;
                 NPeriods : Integer;
                 PV, FV : Extended;
                 Frequency : TStFrequency;
                 Timing : TStPaymentTime) : Extended;
var
  PT, Rw, S : Extended;
begin
  PT := PaymentType[Timing];
  Rw := Rate / CouponsPerYear[Frequency];
  S := Power(1.0 + Rw, NPeriods);
  Result := Rw * (FV - PV * S) / ((S - 1.0) * (1.0 + Rw * PT));
end;

{-------------------------------------------------------}
function Periods(Rate : Extended;
                 Pmt, PV, FV : Extended;
                 Frequency : TStFrequency;
                 Timing: TStPaymentTime) : Integer;
var
  S, Rw  : Extended;

begin
  Rw := Rate / CouponsPerYear[Frequency];
  S := Pmt * (1.0 + Rw * PaymentType[Timing]);
  Result := Round(Ln((Rw*FV + S) / (Rw*PV + S)) / Ln(1.0 + Rw));
end;

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

function PresentValue(Rate : Extended;
                      NPeriods : Integer;
                      Pmt, FV : Extended;
                      Frequency : TStFrequency;
                      Timing : TStPaymentTime) : Extended;
var
  PT, Rw, S  : Extended;
begin
  PT := PaymentType[Timing];
  Rw := Rate / CouponsPerYear[Frequency];
  S := Power(1.0 + Rw, -NPeriods);
  Result := (FV * S) + Pmt * (S - 1.0) * (1.0 + Rw * PT) / Rw;
end;

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

function ReceivedAtMaturity(Settlement, Maturity : TStDate;
                            Investment, Discount : Extended;
                            Basis : TStBasis) : Extended;
var
  DCF : Extended;
begin
  if (Investment <= 0.0) or (Discount <= 0.0) or (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, Basis);
  Result := Investment / (1.0 - Discount * DCF);
end;

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

 {revised}
function RoundToDecimal(Value : Extended;
                        Places : Integer;
                        Bankers : Boolean) : Extended;
var
  Val, IV, N, F : Extended;
  T             : Integer;
begin
  IV := 0;
  N := Exp10(Places);
  if (Places > 0) then
    IV := Int(Value);
  Val := (Value - IV) * N;
  T := Trunc(Val);
  F := (Val - T);
  if Bankers then
    Val := Round(Val) / N        {Delphi's Round does Bankers}
  else begin
    if Abs(Round(10.0 * F)) >= 5 then begin
      if (F > 0) then
        Val := (T + 1.0) / N
      else
        Val := (T - 1.0) / N;
    end else
      Val := T / N;
  end;
  Result := Val + IV;
end;

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

function TBillEquivYield(Settlement, Maturity : TStDate;
                         Discount : Extended) : Extended;
var
  DCF : Extended;
begin
  if (Discount <= 0.0) or (Settlement > Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, BasisAct360);
  if (DCF > 1.0) then
    RaiseStFinError(stscFinBadArg);
  Result := (365.0 / 360.0) * Discount / (1.0 - Discount * DCF);
end;

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

function TBillPrice(Settlement, Maturity : TStDate;
                    Discount : Extended) : Extended;
var
  DCF : Extended;
begin
  if (Discount <= 0.0) or (Settlement > Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, BasisAct360);
  if (DCF > 1.0) then
    RaiseStFinError(stscFinBadArg);
  Result := 100.0 * ( 1.0 - Discount * DCF);
end;

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

function TBillYield(Settlement, Maturity : TStDate;
                    Price : Extended) : Extended;
var
  DCF : Extended;
begin
  if (Price <= 0.0) or (Settlement > Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, BasisAct360);
  if (DCF > 1.0) then
    RaiseStFinError(stscFinBadArg);
  Result := ((100.0 - Price) / Price) * (1.0 / DCF);
end;

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

function VariableDecliningBalance(Cost, Salvage : Extended;
                                  Life : Integer;
                                  StartPeriod, EndPeriod, Factor : Extended;
                                  NoSwitch : Boolean) : Extended;
var
  VDB   : Extended;
  SLD   : Extended;
  Rate  : Extended;
begin
  if (Cost <= 0.0) or (Cost < Salvage) or (Life < 2) or (EndPeriod > Life) or
    (StartPeriod > EndPeriod) or (StartPeriod < 0) then
    RaiseStFinError(stscFinBadArg);
  if (Factor = 0.0) then
    Rate := 2.0 / Life
  else
    Rate := Factor / Life;
  SLD := (Cost - Salvage) * (EndPeriod - StartPeriod) / Life;
  VDB := Cost * (Power(1.0 - Rate, StartPeriod) - Power(1.0 - Rate, EndPeriod));
  if (not NoSwitch) and (SLD > VDB) then
    Result := SLD
  else
    Result := VDB;
end;

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

function YieldDiscounted(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) / (Price * DCF);
end;

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

function YieldPeriodic(Settlement, Maturity : TStDate;
                       Rate, Price, Redemption : Extended;
                       Frequency : TStFrequency;
                       Basis : TStBasis) : Extended;
var
  Yield     : Extended;
  NextYield : Extended;
  P, dP     : Extended;
  Count     : Integer;
begin
  if (Price <= 0.0) or (Rate < 0.0) or (Redemption <= 0.0) or
    (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  Count := 0;
  NextYield := Rate;
  repeat  {Solve B = BondPrice(yield) - Price = 0 by Newton's method}
    if (NextYield > 0) then                                          
      Yield := NextYield                                             
    else                                                             
      Yield := 0.001;                                                
    P := BondPrice(Settlement, Maturity, Rate, Yield, Redemption,
      Frequency, Basis) - Price;
    dP := BondPrice(Settlement, Maturity, Rate, Yield + StDelta,
      Redemption, Frequency, Basis) - Price - P;
    if (dP = 0.0) then
      Count := StMaxIterations
    else
      NextYield := Yield - StDelta * P / dP;
    Inc(Count);
  until (Abs(NextYield - Yield) < StEpsilon) or (Count > StMaxIterations);
  if (Count > StMaxIterations) then
    RaiseStFinError(stscFinNoConverge);
  Result := NextYield;
end;

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

function YieldMaturity(Issue, Settlement, Maturity : TStDate;
                       Rate, Price : Extended;
                       Basis : TStBasis) : Extended;
var
  DCFim, DCFsm, DCFis : Extended;
begin
  if (Price <= 0.0) or (Rate < 0.0) or (Settlement < Issue) or
    (Settlement >= Maturity) then
    RaiseStFinError(stscFinBadArg);
  DCFim := DayCountFraction(Issue, Maturity, Settlement, Maturity,
    fqAnnual, Basis);
  DCFsm := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
    fqAnnual, Basis);
  DCFis := DayCountFraction(Issue, Settlement, Settlement, Maturity,
    fqAnnual, Basis);
  Result := 100.0 * (1.0 + Rate * DCFim);
  Result := Result / (Price + 100.0 * Rate * DCFis);
  Result := (Result - 1.0) / DCFsm;
end;



initialization
  RecipLn10 := 1.0 / Ln(10.0);
end.