home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 10 / strucprg.asc < prev    next >
Text File  |  1991-09-10  |  9KB  |  239 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4.  
  5. [LISTING ONE]
  6.  
  7.          TITLE('COMPUTE MONTHLY PAYMENTS')
  8. PAYMENT      PROGRAM
  9.          INCLUDE('\CLARION\STD_KEYS.CLA') !STANDARD KEYCODE EQUATES
  10.  
  11. SCREEN       SCREEN   HLP('PAYMENT'),HUE(7,0,0)
  12.            ROW(4,25)  PAINT(13,32),HUE(7,1)
  13.          COL(25)  STRING('<201,205{30},187>')
  14.            ROW(5,25)  REPEAT(3);STRING('<186,0{30},186>') .
  15.            ROW(8,25)  STRING('<204,205{30},185>')
  16.            ROW(9,25)  REPEAT(7);STRING('<186,0{30},186>') .
  17.            ROW(16,25) STRING('<200,205{30},188>')
  18.            ROW(6,28)  STRING('CALCULATE MONTHLY PAYMENTS')
  19.            ROW(13,32) STRING('Payment  :')
  20.            ROW(15,30) STRING('Press Ctrl-Esc to Exit')
  21.            ROW(9,32)  STRING('Principal:')
  22.          COL(44)  ENTRY(@N7),USE(AMOUNT),INS,NUM
  23.            ROW(10,32) STRING('Rate {5}:')
  24.          COL(44)  ENTRY(@N7.3),USE(RATE),INS,NUM
  25.            ROW(11,32) STRING('Years    :')
  26.          COL(49)  ENTRY(@N2),USE(YEARS),INS,NUM
  27. PAYMENT        ROW(13,42) STRING(@N9.2)
  28.          .
  29. AMOUNT       DECIMAL(7)          !PRINCIPAL AMOUNT
  30. RATE         DECIMAL(7,3)        !ANNUAL PERCENTAGE RATE
  31. YEARS        DECIMAL(3)          !TERM IN YEARS
  32. MONTHS       DECIMAL(3)          !TERM IN MONTHS
  33. MON_RATE     REAL            !MONTHLY RATE
  34. TEMP         REAL            !INTERMEDIATE VALUE
  35.  
  36.   CODE                   !START THE CODE SECTION
  37.   ALERT(CTRL_ESC)            !ENABLE THE CTRL-ESC KEY
  38.   HELP('PAYMENT')            !OPEN THE HELP FILE
  39.   OPEN(SCREEN)               !DISPLAY THE SCREEN LAYOUT
  40.   LOOP                   !LOOP THROUGH THE FIELDS
  41.     ACCEPT               !GET A FIELD FROM THE KEYBOARD
  42.     IF KEYCODE() = CTRL_ESC THEN RETURN. !EXIT ON CTRL-ESC
  43.  
  44.     IF AMOUNT * RATE * YEARS <> 0    !WHEN ALL FIELDS ARE ENTERED:
  45.       MONTHS = YEARS * 12        !COMPUTE MONTHS
  46.       MON_RATE = RATE / 1200         !COMPUTE MONTHLY RATE
  47.       TEMP = 1 / ((1 + MON_RATE) ^ MONTHS)  !COMPUTE MONTHLY PAYMENT
  48.       PAYMENT = AMOUNT * (MON_RATE / (1 - TEMP))
  49.     ELSE                 !OTHERWISE:
  50.       PAYMENT = 0            !  SET MONTHLY PAYMENT TO ZERO
  51.     .                    !END THE IF STATEMENT
  52.     IF FIELD() = ?YEARS          !AFTER THE LAST FIELD
  53.       SELECT(?AMOUNT)            !  SELECT THE FIRST FIELD
  54.   . .                    !END THE IF AND LOOP STATEMENTS
  55.  
  56.  
  57.  
  58. [LISTING TWO] 
  59.  
  60. { By Jeff Duntemann  --  From DDJ for October 1991 }
  61.  
  62. UNIT Mortgage;
  63.  
  64. INTERFACE
  65.  
  66. TYPE
  67.   Payment = RECORD      { One element in the amort. table. }
  68.               PayPrincipal   : Real;
  69.               PayInterest    : Real;
  70.               PrincipalSoFar : Real;
  71.               InterestSoFar  : Real;
  72.               ExtraPrincipal : Real;
  73.               Balance        : Real;
  74.             END;
  75.   PaymentArray   = ARRAY[1..2] OF Payment;  { Dynamic array! }
  76.   PaymentPointer = ^PaymentArray;
  77.  
  78.   PMortgage = ^TMortgage;
  79.   TMortgage =
  80.     OBJECT
  81.       Periods        : Integer;  { Number of periods in mortgage    }
  82.       PeriodsPerYear : Integer;  { Number of periods in a year      }
  83.       Principal      : Real;     { Amount of principal in cents     }
  84.       Interest       : Real;     { Percentage of interest per *YEAR*}
  85.  
  86.       MonthlyPI   : Real;        { Monthly payment in cents         }
  87.       Payments    : PaymentPointer;  { Array holding payments       }
  88.       PaymentSize : LongInt;     { Size in bytes of payments array  }
  89.  
  90.       CONSTRUCTOR Init(StartPrincipal      : Real;
  91.                        StartInterest       : Real;
  92.                        StartPeriods        : Integer;
  93.                        StartPeriodsPerYear : Integer);
  94.       PROCEDURE SetNewInterestRate(NewRate : Real);
  95.       PROCEDURE Recalc;
  96.       PROCEDURE GetPayment(PaymentNumber   : Integer;
  97.                            VAR ThisPayment : Payment);
  98.       PROCEDURE ApplyExtraPrincipal(PaymentNumber : Integer;
  99.                                     Extra         : Real);
  100.       PROCEDURE RemoveExtraPrincipal(PaymentNumber : Integer);
  101.       DESTRUCTOR  Done;
  102.     END;
  103.  
  104. IMPLEMENTATION
  105. FUNCTION CalcPayment(Principal,InterestPerPeriod : Real;
  106.                      NumberOfPeriods  : Integer) : Real;
  107. VAR
  108.   Factor : Real;
  109. BEGIN
  110.   Factor := EXP(-NumberOfPeriods * LN(1.0 + InterestPerPeriod));
  111.   CalcPayment := Principal * InterestPerPeriod / (1.0 - Factor)
  112. END;
  113.  
  114. CONSTRUCTOR TMortgage.Init(StartPrincipal      : Real;
  115.                            StartInterest       : Real;
  116.                            StartPeriods        : Integer;
  117.                            StartPeriodsPerYear : Integer);
  118. VAR
  119.   I : Integer;
  120.   InterestPerPeriod  : Real;
  121. BEGIN
  122.   { Set up all the initial state values: }
  123.   Principal := StartPrincipal;
  124.   Interest  := StartInterest;
  125.   Periods   := StartPeriods;
  126.   PeriodsPerYear := StartPeriodsPerYear;
  127.   { Here we calculate the size that the payment array will occupy. }
  128.   { We retain this because the number of payments may change...and }
  129.   { we'll need to dispose of the array when the object is ditched: }
  130.   PaymentSize := SizeOf(Payment) * Periods;
  131.  
  132.   { Allocate payment array on the heap: }
  133.   GetMem(Payments,PaymentSize);
  134.  
  135.   { Initialize extra principal fields of payment array: }
  136.   FOR I := 1 TO Periods DO
  137.     Payments^[I].ExtraPrincipal := 0;
  138.   Recalc;  { Calculate the amortization table }
  139. END;
  140.  
  141. PROCEDURE TMortgage.SetNewInterestRate(NewRate : Real);
  142. BEGIN
  143.   Interest := NewRate;
  144.   Recalc;
  145. END;
  146.  
  147. { This method calculates the amortization table for the mortgage. }
  148. { The table is stored in the array pointed to by Payments.     }
  149.  
  150. PROCEDURE TMortgage.Recalc;
  151. VAR
  152.   I : Integer;
  153.   RemainingPrincipal    : Real;
  154.   PaymentCount          : Integer;
  155.   InterestThisPeriod    : Real;
  156.   InterestPerPeriod     : Real;
  157.   HypotheticalPrincipal : Real;
  158. BEGIN
  159.   InterestPerPeriod := Interest/PeriodsPerYear;
  160.   MonthlyPI := CalcPayment(Principal,
  161.                            InterestPerPeriod,
  162.                            Periods);
  163.   { Round the monthly to cents: }
  164.   MonthlyPI := int(MonthlyPI * 100.0 + 0.5) / 100.0;
  165.  
  166.   { Now generate the amortization table: }
  167.   RemainingPrincipal := Principal;
  168.   PaymentCount := 0;
  169.   FOR I := 1 TO Periods DO
  170.     BEGIN
  171.       Inc(PaymentCount);
  172.       { Calculate the interest this period and round it to cents:  }
  173.       InterestThisPeriod :=
  174.         Int((RemainingPrincipal * InterestPerPeriod) * 100 + 0.5) / 100.0;
  175.       { Store values into payments array: }
  176.       WITH Payments^[PaymentCount] DO
  177.         BEGIN
  178.           IF RemainingPrincipal = 0 THEN  { Loan's been paid off! }
  179.             BEGIN
  180.               PayInterest := 0;
  181.               PayPrincipal := 0;
  182.               Balance := 0;
  183.             END
  184.           ELSE
  185.             BEGIN
  186.               HypotheticalPrincipal :=
  187.               MonthlyPI - InterestThisPeriod + ExtraPrincipal;
  188.               IF HypotheticalPrincipal > RemainingPrincipal THEN
  189.                 PayPrincipal := RemainingPrincipal
  190.               ELSE
  191.                 PayPrincipal := HypotheticalPrincipal;
  192.               PayInterest  := InterestThisPeriod;
  193.               RemainingPrincipal :=
  194.                 RemainingPrincipal - PayPrincipal; { Update running balance }
  195.               Balance := RemainingPrincipal;
  196.             END;
  197.           { Update the cumulative interest and principal fields: }
  198.           IF PaymentCount = 1 THEN
  199.             BEGIN
  200.               PrincipalSoFar := PayPrincipal;
  201.               InterestSoFar  := PayInterest;
  202.             END
  203.           ELSE
  204.             BEGIN
  205.               PrincipalSoFar :=
  206.                 Payments^[PaymentCount-1].PrincipalSoFar + PayPrincipal;
  207.               InterestSoFar  :=
  208.                 Payments^[PaymentCount-1].InterestSoFar + PayInterest;
  209.             END;
  210.         END;  { WITH }
  211.     END;      { FOR }
  212. END;          { TMortgage.Recalc }
  213.  
  214. PROCEDURE TMortgage.GetPayment(PaymentNumber   : Integer;
  215.                                VAR ThisPayment : Payment);
  216. BEGIN
  217.   ThisPayment := Payments^[PaymentNumber];
  218. END;
  219.  
  220. PROCEDURE TMortgage.ApplyExtraPrincipal(PaymentNumber : Integer;
  221.                                         Extra         : Real);
  222. BEGIN
  223.   Payments^[PaymentNumber].ExtraPrincipal := Extra;
  224.   Recalc;
  225. END;
  226.  
  227. PROCEDURE TMortgage.RemoveExtraPrincipal(PaymentNumber : Integer);
  228. BEGIN
  229.   Payments^[PaymentNumber].ExtraPrincipal := 0.0;
  230.   Recalc;
  231. END;
  232.  
  233. DESTRUCTOR TMortgage.Done;
  234. BEGIN
  235.   FreeMem(Payments,PaymentSize);
  236. END;
  237.  
  238. END.  { MORTGAGE }
  239.