{\$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
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 *)

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);

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.