_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 }