home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug048.arc / LOAN.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  7KB  |  218 lines
  1. {Loan Repayment Calculator}
  2. {by Paul Shannon}
  3. {MBUG member 1219}
  4.  
  5. {Calculates the total amount and total interest paid on a reducing balance
  6. loan.}
  7.  
  8. var
  9.    INTEREST, BAL, INITBAL, PRINC, INTERESTRATE, REPAYMENT, REPAYTEST,
  10.    INITREPAYMENT, REPAYMENTSUM, FINALPAYMENT, INTERESTSUM,
  11.    MAXPAYMENT, STEP : REAL;
  12.    MONTH, YEAR : INTEGER;
  13.    MULTDISPLAY, AGAIN, VIDEO : CHAR;
  14.  
  15. procedure YESORNO (var YES {output} : CHAR);
  16.  
  17.   begin {Yes or No}
  18.     YES := ' ';
  19.     while (YES <> 'N') and (YES <> 'Y') do
  20.       begin
  21.         WRITE ('  (Y/N) ');
  22.         READLN (YES);
  23.         YES := UPCASE (YES)
  24.       end;
  25.   end; {Yes or No}
  26.  
  27. procedure TITLES;
  28.   begin
  29.     CLRSCR;
  30.     WRITELN ('Loan Repayment Calculator' : 40);
  31.     WRITELN ('By Paul Shannon' : 35);
  32.     WRITELN;
  33.     WRITELN ('   This utility program is designed to calculate the total TIME, total');
  34.     WRITELN ('REPAYMENTS, and total INTEREST, on a reducing balance loan.  All ');
  35.     WRITELN ('calculations are based on monthly interest calculations, and monthly');
  36.     WRITELN ('repayments.');
  37.     WRITELN;
  38.     WRITELN ('   The difference between this and most other loan calculators, is it''s ability');
  39.     WRITELN ('to automatically increment the repayment rate, and recalculate the loan,');
  40.     WRITELN ('accordingly.');
  41.     WRITELN;
  42.     WRITELN ('   While you are entering the data, you will be asked if you wish to do');
  43.     WRITELN ('multiple calculations.  Should you answer yes, the computer will recalculate');
  44.     WRITELN ('your loan as many times as desired, each time incrementing the repayment rate');
  45.     WRITELN ('by a set step size.  This should prove very useful when deciding how much');
  46.     WRITELN ('you wish to pay off your loan each month.')
  47.   end; {Titles}
  48.  
  49. procedure INPUT;
  50.   begin
  51.     WRITELN;
  52.     INITBAL := 0;
  53.     while INITBAL < 0.01 do
  54.       begin
  55.         WRITE ('Enter the PRINCIPAL to be borrowed:  $'); READLN (INITBAL)
  56.       end;
  57.     PRINC := INITBAL;
  58.     INTERESTRATE := 100;
  59.     while (INTERESTRATE >= 100) or (INTERESTRATE < 0) doè      begin
  60.         WRITE ('Enter the YEARLY (%) INTEREST RATE:  ');
  61.         READLN (INTERESTRATE)
  62.       end;
  63.     INTERESTRATE := INTERESTRATE / 1200;
  64.     REPAYTEST := INITBAL * INTERESTRATE;
  65.     REPAYMENT := REPAYTEST - 1;
  66.     WRITE ('Multiple loan calculations?');
  67.     YESORNO (MULTDISPLAY);
  68.     while REPAYMENT <= REPAYTEST + 0.01 do
  69.       begin {Repayment test}
  70.         WRITE ('Enter the ');
  71.           if MULTDISPLAY = 'Y' then
  72.             WRITE ('MINIMUM ');
  73.           WRITE ('monthly repayment (must be greater than $',
  74.           REPAYTEST : 8 : 2, ')  $'); READLN (REPAYMENT)
  75.       end {Repayment test};
  76.     if MULTDISPLAY = 'Y' then
  77.       begin {Multiple calculations}
  78.         MAXPAYMENT := PRINC + 1;
  79.         while MAXPAYMENT > PRINC do
  80.           begin
  81.             WRITE ('Enter the MAXIMUM monthly repayment:  $');
  82.             READLN (MAXPAYMENT)
  83.           end;
  84.         WRITE ('Enter the step size:  $'); READLN (STEP)
  85.       end {Multiple calculations}
  86.   end; {Input}
  87.  
  88. procedure DISPLAY;
  89.   begin
  90.     WRITE ('Do you wish to display the calculations?');
  91.     YESORNO (VIDEO);
  92.     if VIDEO = 'Y' then
  93.       begin
  94.         WRITELN;
  95.         WRITELN ('(Use CTRL-S to pause.)');
  96.         WRITELN;
  97.         DELAY (2000);
  98.         WRITELN ('Month' : 8, 'Initial' : 12, 'Interest' : 17,
  99.                  'Repayment' : 15, 'Final' : 13);
  100.         WRITELN ('Balance' : 20, 'Balance' : 45);
  101.         WRITELN
  102.       end
  103.     else
  104.       begin
  105.         WRITELN;
  106.         WRITELN ('Please wait.')
  107.       end
  108.   end; {Display}
  109.  
  110. procedure CALCULATE;
  111.   begin
  112.     MONTH := 0;
  113.     REPAYMENTSUM := 0;
  114.     INITBAL := PRINC;
  115.     while INITBAL >= 0.01 do
  116.       begin {calculate loop}
  117.         MONTH := MONTH + 1;è        INTEREST := INITBAL * INTERESTRATE;
  118.         if REPAYMENT > INITBAL + INTEREST then
  119.           begin
  120.             FINALPAYMENT := INITBAL + INTEREST;
  121.             REPAYMENTSUM := REPAYMENTSUM + FINALPAYMENT;
  122.             BAL := INITBAL + INTEREST - FINALPAYMENT
  123.           end
  124.         else
  125.           begin
  126.             REPAYMENTSUM := REPAYMENTSUM + REPAYMENT;
  127.             BAL := INITBAL + INTEREST - REPAYMENT
  128.           end;
  129.         if VIDEO = 'Y' then
  130.            WRITELN (MONTH : 5, INITBAL : 15 : 2, INTEREST : 15 : 2,
  131.            REPAYMENT : 15 : 2, BAL : 15 : 2);
  132.         INITBAL := BAL
  133.       end; {calculate loop}
  134.       YEAR := MONTH div 12;
  135.       MONTH := MONTH mod 12
  136.     end; {Calculate}
  137.  
  138. procedure PRINT_SINGLE;
  139.   begin
  140.     WRITELN;
  141.     WRITELN ('STATISTICS:');
  142.     WRITELN;
  143.     WRITELN ('Principal borrowed:  $', PRINC : 10 : 2);
  144.     WRITELN ('Interest Rate:', INTERESTRATE * 1200 : 18 : 2,
  145.             '% p.a. (compounded montly) ');
  146.     WRITELN ('Repayment rate:   $', REPAYMENT : 13 : 2, ' per month');
  147.     WRITELN;
  148.     WRITE ('Time:  ', YEAR : 25, ' Year');
  149.     if YEAR <> 1 then
  150.       WRITE ('s');
  151.     WRITE (' and ', MONTH, ' month');
  152.     if MONTH <> 1 then
  153.       WRITELN ('s')
  154.     else WRITELN;
  155.     WRITELN ('Total Repayments:  $', REPAYMENTSUM : 12 : 2);
  156.     WRITELN ('Total Interest:    $', REPAYMENTSUM - PRINC : 12 : 2)
  157.   end; {Printout}
  158.  
  159. procedure MULTIPLE;
  160. var
  161.   LINE : INTEGER;
  162.   CONTINUE : CHAR;
  163.  
  164.   begin
  165.    LINE := 0;
  166.    VIDEO := 'N';
  167.    CONTINUE := 'Y';
  168.    WRITELN;
  169.    WRITELN ('$', PRINC : 12 : 2, ' at ', INTERESTRATE * 1200 : 5 : 2,
  170.      ' % p.a.');
  171.    WRITELN;
  172.    WRITELN ('    Monthly              Time              Total          Total');
  173.    WRITELN ('   Repayment                            Repayments      Interest');
  174.    WRITELN;
  175.    while (REPAYMENT <= MAXPAYMENT) and (CONTINUE <> 'N') doè      begin
  176.         CALCULATE;
  177.         LINE := LINE + 1;
  178.         WRITE (REPAYMENT : 10 : 2, YEAR : 9, ' year');
  179.         if YEAR <> 1 then
  180.           WRITE ('s, ')
  181.         else
  182.           WRITE (',  ');
  183.         WRITE (MONTH : 2, ' month');
  184.         if MONTH <> 1 then
  185.           WRITE ('s')
  186.         else
  187.           WRITE (' ');
  188.         WRITELN (REPAYMENTSUM : 14 : 2, REPAYMENTSUM - PRINC : 14 : 2);
  189.         REPAYMENT := REPAYMENT + STEP;
  190.         if LINE > 22 then
  191.           begin
  192.             LINE := 0;
  193.             WRITE ('More?');
  194.             YESORNO (CONTINUE);
  195.           end {if}
  196.       end {while}
  197.   end; {Multiple}
  198.  
  199. begin {Main Program}
  200.   TITLES;
  201.     AGAIN := 'Y';
  202.     while AGAIN = 'Y' do
  203.       begin
  204.         INPUT;
  205.         if MULTDISPLAY = 'N' then
  206.           begin
  207.             DISPLAY;
  208.             CALCULATE;
  209.             PRINT_SINGLE
  210.           end
  211.         else
  212.           MULTIPLE;
  213.           WRITELN;
  214.           WRITE ('Any more calculations?');
  215.           YESORNO (AGAIN)
  216.     end {Again}
  217. end. {Main Program}
  218.