Category : Files from Magazines
Archive   : DDJ0892.ZIP
Filename : TMORTG.ASC

_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann

[LISTING ONE]

{----------------------------------------------------------------------------}
{ MORTGAGE }
{ By Jeff Duntemann -- From DDJ for August 1992 }
{ Last Updated 5/2/92 }
{ Major update: 3/25/92: }
{ Added all the rigmarole to make the TMortgage type streamable. It now }
{ descends from TObject and uses the Objects unit. I also added the }
{ registration record and the Load and Store methods. }
{----------------------------------------------------------------------------}

UNIT Mortgage;

INTERFACE

USES Objects;

TYPE
Payment = RECORD { One element in the amort. table. }
PayPrincipal : Real;
PayInterest : Real;
PrincipalSoFar : Real;
InterestSoFar : Real;
ExtraPrincipal : Real;
Balance : Real;
END;
PaymentArray = ARRAY[1..2] OF Payment; { Dynamic array! }
PaymentPointer = ^PaymentArray;

PMortgage = ^TMortgage;
TMortgage =
OBJECT(TObject) { Must descend from TObject to be streamable }
Periods : Integer; { Number of periods in mortgage }
PeriodsPerYear : Integer; { Number of periods in a year }
Principal : Real; { Amount of principal in cents }
Interest : Real; { Percentage of interest per *YEAR*}

MonthlyPI : Real; { Monthly payment in cents }
Payments : PaymentPointer; { Array holding payments }
PaymentSize : LongInt; { Size in bytes of payments array }

CONSTRUCTOR Init(StartPrincipal : Real;
StartInterest : Real;
StartPeriods : Integer;
StartPeriodsPerYear : Integer);
CONSTRUCTOR Load(VAR S : TStream);
PROCEDURE SetNewInterestRate(NewRate : Real);
PROCEDURE Recalc;
PROCEDURE GetPayment(PaymentNumber : Integer;
VAR ThisPayment : Payment);
PROCEDURE ApplyExtraPrincipal(PaymentNumber : Integer;
Extra : Real);
PROCEDURE RemoveExtraPrincipal(PaymentNumber : Integer);
PROCEDURE Store(VAR S : TStream);
DESTRUCTOR Done; VIRTUAL;
END;

CONST
RMortgage : TStreamRec =
(ObjType : 1200;
VMTLink : Ofs(TypeOf(TMortgage)^);
Load : @TMortgage.Load;
Store : @TMortgage.Store);

IMPLEMENTATION

FUNCTION CalcPayment(Principal,InterestPerPeriod : Real;
NumberOfPeriods : Integer) : Real;
VAR
Factor : Real;
BEGIN
Factor := EXP(-NumberOfPeriods * LN(1.0 + InterestPerPeriod));
CalcPayment := Principal * InterestPerPeriod / (1.0 - Factor)
END;

CONSTRUCTOR TMortgage.Init(StartPrincipal : Real;
StartInterest : Real;
StartPeriods : Integer;
StartPeriodsPerYear : Integer);
VAR
I : Integer;
InterestPerPeriod : Real;
BEGIN
{ Set up all the initial state values: }
Principal := StartPrincipal;
Interest := StartInterest;
Periods := StartPeriods;
PeriodsPerYear := StartPeriodsPerYear;

{ Here we calculate the size that the payment array will occupy. }
{ We retain this because the number of payments may change...and }
{ we'll need to dispose of the array when the object is ditched: }
PaymentSize := SizeOf(Payment) * Periods;

{ Allocate payment array on the heap: }
GetMem(Payments,PaymentSize);

{ Initialize extra principal fields of payment array: }
FOR I := 1 TO Periods DO
Payments^[I].ExtraPrincipal := 0;
Recalc; { Calculate the amortization table }
END;

CONSTRUCTOR TMortgage.Load(VAR S : TStream);
BEGIN
S.Read(Periods, Sizeof(Integer));
S.Read(PeriodsPerYear,SizeOf(Integer));
S.Read(Principal, SizeOf(Real));
S.Read(Interest, SizeOf(Real));
S.Read(MonthlyPI, SizeOf(Real));
S.Read(PaymentSize, SizeOf(LongInt));
{ Note that we *don't* try to read a pointer in from the stream. That would }
{ be meaningless; instead, we allocate heap space for the payments array }
{ with GetMem and assign the returned pointer to Payments: }
GetMem(Payments,PaymentSize);
S.Read(Payments^, PaymentSize);
END;

PROCEDURE TMortgage.Store(VAR S : TStream);
BEGIN
S.Write(Periods, Sizeof(Integer));
S.Write(PeriodsPerYear,SizeOf(Integer));
S.Write(Principal, SizeOf(Real));
S.Write(Interest, SizeOf(Real));
S.Write(MonthlyPI, SizeOf(Real));
{ Note that we *don't* store the pointer to the payments array! }
{ A pointer (i.e., a heap address) is meaningless written to disk.}
S.Write(PaymentSize, SizeOf(LongInt));
S.Write(Payments^, PaymentSize);
END;

PROCEDURE TMortgage.SetNewInterestRate(NewRate : Real);
BEGIN
Interest := NewRate;
Recalc;
END;

{ This method calculates the amortization table for the mortgage. }
{ The table is stored in the array pointed to by Payments. }

PROCEDURE TMortgage.Recalc;
VAR
I : Integer;
RemainingPrincipal : Real;
PaymentCount : Integer;
InterestThisPeriod : Real;
InterestPerPeriod : Real;
HypotheticalPrincipal : Real;
BEGIN
InterestPerPeriod := Interest/PeriodsPerYear;
MonthlyPI := CalcPayment(Principal,
InterestPerPeriod,
Periods);
{ Round the monthly to cents: }
MonthlyPI := int(MonthlyPI * 100.0 + 0.5) / 100.0;

{ Now generate the amortization table: }
RemainingPrincipal := Principal;
PaymentCount := 0;
FOR I := 1 TO Periods DO
BEGIN
Inc(PaymentCount);
{ Calculate the interest this period and round it to cents: }
InterestThisPeriod :=
Int((RemainingPrincipal * InterestPerPeriod) * 100 + 0.5) / 100.0;
{ Store values into payments array: }
WITH Payments^[PaymentCount] DO
BEGIN
IF RemainingPrincipal = 0 THEN { Loan's been paid off! }
BEGIN
PayInterest := 0;
PayPrincipal := 0;
Balance := 0;
END
ELSE
BEGIN
HypotheticalPrincipal :=
MonthlyPI - InterestThisPeriod + ExtraPrincipal;
IF HypotheticalPrincipal > RemainingPrincipal THEN
PayPrincipal := RemainingPrincipal
ELSE
PayPrincipal := HypotheticalPrincipal;
PayInterest := InterestThisPeriod;
RemainingPrincipal :=
RemainingPrincipal - PayPrincipal; { Update running balance }
Balance := RemainingPrincipal;
END;
{ Update the cumulative interest and principal fields: }
IF PaymentCount = 1 THEN
BEGIN
PrincipalSoFar := PayPrincipal;
InterestSoFar := PayInterest;
END
ELSE
BEGIN
PrincipalSoFar :=
Payments^[PaymentCount-1].PrincipalSoFar + PayPrincipal;
InterestSoFar :=
Payments^[PaymentCount-1].InterestSoFar + PayInterest;
END;
END; { WITH }
END; { FOR }
END; { TMortgage.Recalc }

PROCEDURE TMortgage.GetPayment(PaymentNumber : Integer;
VAR ThisPayment : Payment);
BEGIN
ThisPayment := Payments^[PaymentNumber];
END;

PROCEDURE TMortgage.ApplyExtraPrincipal(PaymentNumber : Integer;
Extra : Real);
BEGIN
Payments^[PaymentNumber].ExtraPrincipal := Extra;
Recalc;
END;

PROCEDURE TMortgage.RemoveExtraPrincipal(PaymentNumber : Integer);
BEGIN
Payments^[PaymentNumber].ExtraPrincipal := 0.0;
Recalc;
END;

DESTRUCTOR TMortgage.Done;
BEGIN
FreeMem(Payments,PaymentSize);
END;

END. { MORTGAGE }