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.