Contributor: FERNAND LEMOINE


UNIT business;
  {$N+}

 (*  DESCRIPTION :
   I.  Financial functions from spreadsheet - Fonctions financiŠres.
       Name of functions , number and order of arguments are based upon
       Lotus 1-2-3 and Quattro , which are different from Excel.
  II.  Conversion : anglo-saxon measure unit <---->  metric measure unit
       Conversion entre mesures anglo-saxonnes et m‚triques.
 III.  Percentage calculation - Calcul de pourcentage .

     RELEASE     :  2.0
     DATE        :  27/02/94
     AUTHOR      :  Fernand LEMOINE
                    rue du CollŠge 34
                    B-6200 CHATELET
                    BELGIQUE
     All code granted to the public domain
     Questions and comments are welcome
     REQUIREMENT :  Turbo Pascal 5.0 or later
     Compatible with Borland Pascal protected mode
     Compatible with Borland Pascal for Windows (Wincrt)
  *)

INTERFACE
CONST
  Max_Pmt = 12;
TYPE
  Currency = Comp;
  SeriesPmt = ARRAY[1..Max_Pmt] OF Currency;

VAR
  scale_currency : Real;

(* Interfaced only for use by other units
   Conversion  real ---> currency        *)
FUNCTION ToCurrency(value : Real) : Currency;

  (* Set number of decimal  for currency type  *)
PROCEDURE Set_Dec_Prec(value : Byte);

PROCEDURE WriteCurrency(width : Byte; value : Currency);
(*  width = total length ;
   number of decimals fixed by Set_Dec_Prec *)

(*-I-------------------- Financial functions -----------------------------
   Interest Rate is expressed as a decimal number, not as a percent.
   The Rate period must match the payment period.                     *)

  (* Straight line depreciation - Amortissement lin‚aire                *)
FUNCTION Sln(InitialValue, Residue : real; Time : Byte) : Currency;
  (* Sum of the year digits depreciation - Amortissement d‚gressif      *)
FUNCTION Syd(InitialValue, Residue : real; Period, Time : Byte) : Currency;
  (* Number of compounding periods - Dur‚e de capitalisation            *)
FUNCTION Cterm(Rate : Real; FutureValue, PresentValue : real) : Real;
  (* Number of payments - Nombre de p‚riodes                            *)
FUNCTION Term(Payment : real; Rate : Real; FutureValue : real) : Real;
  (* Payment - Remboursement                                            *)
FUNCTION Pmt(Principal : real; Rate : Real; Term : Byte) : Currency;
  (* Periodic interest Rate - Taux d'int‚rˆt                            *)
FUNCTION Rate(FutureValue, PresentValue : real; Term : Byte) : Real;
  (* Present value - Valeur actualis‚e                                  *)
FUNCTION Pv(Payment : real; Rate : Real; Term : Byte) : Currency;
  (* Net present value  - Valeur actualis‚e d'une s‚rie                 *)
FUNCTION Npv(Rate : Real; Series : SeriesPmt) : Currency;
  (* Future value - Valeur … terme                                      *)
FUNCTION Fv(Payment : real; Rate : Real; Term : Byte) : Currency;

  (*  II - Conversion : anglo-saxon measure unit <--> metric measure unit ---*)

  (* ø Celsius to ø Fahrenheit  *)
FUNCTION CelsToFahr(value : Real) : Real;
  (* ø Fahrenheit to ø Celsius  *)
FUNCTION FahrToCels(value : Real) : Real;
  (*  US Gallons  to litres  *)
FUNCTION GalToL(value : Real) : Real;
  (*  Litres to US gallons   *)
FUNCTION LToGal(value : Real) : Real;
  (*  Inch  to cm            *)
FUNCTION InchToCm(value : Real) : Real;
  (*  Cm    to inch          *)
FUNCTION CmToInch(value : Real) : Real;
  (*  Pounds to kilograms       *)
FUNCTION LbToKg(value : Real) : Real;
  (*  Kilograms to pounds       *)
FUNCTION KgToLb(value : Real) : Real;

  (* III ------------------ Percentage  calculation -----------------------*)

  (* Compute value2 % from value1  *)
FUNCTION Percent(value1, value2 : Real) : Real;
  (* Per cent deviation between value1 and value2 . Result is lower than 1  *)
FUNCTION DeltaPercent(value1, value2 : Real) : Real;

IMPLEMENTATION

VAR
  decimal_currency : Word;

  FUNCTION Power(number, exponent : Real) : Real;
  BEGIN
    IF number > 0.0 THEN
      Power := Exp(exponent * ln(number))
    ELSE
      Power := 0.0
  END;

  PROCEDURE Set_Dec_Prec(value : Byte);
  BEGIN
    decimal_currency := value;
    scale_currency := Power(10, decimal_currency);
  END;

  FUNCTION ToCurrency(value : Real) : Currency;
  BEGIN
    ToCurrency := value * scale_currency;
  END;

  PROCEDURE WriteCurrency(width : Byte; value : Currency);
  BEGIN
    WriteLn(value / scale_currency:width:decimal_currency);
  END;
  (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  FUNCTION Sln(InitialValue, Residue : real; Time : Byte) : Currency;
  BEGIN
    Sln := (ToCurrency(InitialValue) - ToCurrency(Residue)) / Time;
  END;

  FUNCTION Syd(InitialValue, Residue : real; Period, Time : Byte) : Currency;
  BEGIN
    Syd := (ToCurrency(InitialValue) - ToCurrency(Residue)) *
    ((Period + 1 - Time) / (Period * (Period + 1) / 2));
  END;

  FUNCTION Cterm(Rate : Real; FutureValue, PresentValue : real) : Real;
  BEGIN
    Cterm := (ln(ToCurrency(FutureValue) / ToCurrency(PresentValue)) /
              ln(1 + Rate));
  END;

  FUNCTION Term(Payment : real; Rate : Real; FutureValue : real) : Real;
  BEGIN
    Term := (ln(1 + ToCurrency(FutureValue) * (Rate / ToCurrency(Payment))) /
             ln(1 + Rate));
  END;

  FUNCTION Pmt(Principal : real; Rate : Real; Term : Byte) : Currency;
  BEGIN
    Pmt := ToCurrency(Principal) * (Rate / (1 - Power(1 + Rate, - Term)));
  END;

  FUNCTION Rate(FutureValue, PresentValue : real; Term : Byte) : Real;
  BEGIN
    Rate := Power((FutureValue) / (PresentValue), 1 / Term) - 1;
  END;

  FUNCTION Pv(Payment : real; Rate : Real; Term : Byte) : Currency;
  BEGIN
    Pv := (ToCurrency(Payment) * (1 - Power(1 + Rate, - Term)) / Rate);
  END;

  FUNCTION Npv(Rate : Real; Series : SeriesPmt) : Currency;
  VAR
    i, number : Byte;
    N : Currency;
  BEGIN
    N := 0; i := 1; number := Max_Pmt;
    REPEAT
      IF Series[i] = 0 THEN number := i;
      Inc(i);
    UNTIL (i = Max_Pmt) OR (Series[i] = 0);

    FOR i := 1 TO number DO
      N := N + (ToCurrency(Series[i]) / Power(1 + Rate, i));
    Npv := N;
  END;

  FUNCTION Fv(Payment : real; Rate : Real; Term : Byte) : Currency;
  BEGIN
    Fv := ToCurrency(Payment) * (Power(1 + Rate, Term) - 1) / Rate;
  END;
  (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  FUNCTION CelsToFahr(value : Real) : Real;
  BEGIN
    CelsToFahr := 9 / 5 * value + 32;
  END;

  FUNCTION FahrToCels(value : Real) : Real;
  BEGIN
    FahrToCels := 5 / 9 * (value - 32);
  END;

  FUNCTION GalToL(value : Real) : Real;
  BEGIN
    GalToL := value * 3.785411784;
  END;

  FUNCTION LToGal(value : Real) : Real;
  BEGIN
    LToGal := value / 3.785411784;
  END;

  FUNCTION InchToCm(value : Real) : Real;
  BEGIN
    InchToCm := value * 2.54;
  END;

  FUNCTION CmToInch(value : Real) : Real;
  BEGIN
    CmToInch := value / 2.54;
  END;

  FUNCTION LbToKg(value : Real) : Real;
  BEGIN
    LbToKg := value * 0.45359237;
  END;

  FUNCTION KgToLb(value : Real) : Real;
  BEGIN
    KgToLb := value / 0.45359237;
  END;
  (*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
  FUNCTION Percent(value1, value2 : Real) : Real;
  BEGIN
    Percent := (value1 * value2) / 10000;
  END;

  FUNCTION DeltaPercent(value1, value2 : Real) : Real;
  BEGIN
    IF value2 = 0.0 THEN DeltaPercent := 0
    ELSE DeltaPercent := (value1 - value2) / value2;
  END;

BEGIN
  Set_Dec_Prec(2);

END.


{ ------------------------------   DEMO PROGRAM  ------------ }
program demobus;
{$N+}  (* Necessary *)
{$IFNDEF CPU87}
{$E+}  (* if no coprocessor is present, emulation is used  *)
{$ENDIF}

(* Demonstration program for use of business unit *)

uses business,crt;

const
 S : SeriesPmt = (1000,2000,5000,2000,0,0,0,0,0,0,0,0);

var
 R1,R2 :real;

 begin
  clrscr;

   Set_Dec_Prec(3);

  Writeln('Demo business unit');writeln;

  WriteCurrency (10,Sln(100000,30000,10));
  WriteCurrency (10,Syd(100000,12000,10,10));
  Writeln (Cterm(0.03,200000,100000):2:2);
  Writeln (Term(200,0.075,10000):2:2);
  WriteCurrency (10,Pmt(300000,0.03,20));
  Writeln (Rate(2159,1000,10):2:4);
  WriteCurrency (10,Pv(1000,0.03,20));
  WriteCurrency (8,Npv(0.08,S));
  WriteCurrency (10,Fv(1000,0.03,20));

  R1 := 15.8;  R2 := 60.4;
  writeln(CelsToFahr(R1):2:2);
  writeln(FahrToCels(R2):2:2);
  writeln(InchToCm(R1):2:2);
  writeln(CmToInch(R2):2:2);
  writeln(LbToKg(R1):2:2);
  writeln(KgToLb(R2):2:2);
  writeln(GalToL(R1):2:2);
  writeln(LToGal(R2):2:2);

  writeln(Percent(350,22):2:2 );
  writeln(DeltaPercent(4,8):1:2);
  writeln(DeltaPercent(8,4):1:2);

  delay(2500);
 end.