home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PASTUT24.ZIP / PTUTRSRC.ZIP / AMORT4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-01  |  3.1 KB  |  99 lines
  1.                                      (* Chapter 14 - Program 4 *)
  2. program Amortization_Table;
  3.  
  4. var Month : 1..12;
  5.     Starting_Month : 1..12;
  6.     Balance : real;
  7.     Payment : real;
  8.     Interest_Rate : real;
  9.     Annual_Accum_Interest : real;
  10.     Year : integer;
  11.     Number_Of_Years : integer;
  12.     Original_Loan : real;
  13.  
  14.  
  15. procedure Calculate_Payment; (* **************** calculate payment *)
  16. var Temp : real;
  17.     Index : integer;
  18. begin
  19.    Temp := 1.0;
  20.    for Index := 1 TO 12*Number_Of_Years do
  21.      Temp := Temp * (1.0 + Interest_Rate);
  22.    Payment := Original_Loan*Interest_Rate/(1.0 - 1.0/Temp);
  23. end;
  24.  
  25. procedure Initialize_Data; (* ******************** initialize data *)
  26. begin
  27.    Writeln('   Pascal amortization program');
  28.    Writeln;
  29.    Write('Enter amount borrowed                         ');
  30.    Readln(Original_Loan);
  31.    Balance := Original_Loan;
  32.    Write('Enter interest rate as percentage (i.e. 13.5) ');
  33.    Readln(Interest_Rate);
  34.    Interest_Rate := Interest_Rate/1200.0;
  35.    Write('Enter number of years of payoff               ');
  36.    Readln(Number_Of_Years);
  37.    Write('Enter month of first payment (i.e. 5 for May) ');
  38.    Readln(Starting_Month);
  39.    Write('Enter year of first payment (i.e. 1985)       ');
  40.    Readln(Year);
  41.    Calculate_Payment;
  42.    Annual_Accum_Interest := 0.0; (* This is to accumulate Interest *)
  43. end;
  44.  
  45. procedure Print_Annual_Header; (* ************ print annual header *)
  46. begin
  47.    Writeln;
  48.    Writeln;
  49.    Writeln('Original loan amount = ',Original_Loan:10:2,
  50.            '   Interest rate = ',1200.0*Interest_Rate:6:2,'%');
  51.    Writeln;
  52.    Writeln('Month    payment  interest    princ   balance');
  53.    Writeln;
  54. end;
  55.  
  56. procedure Calculate_And_Print; (* ************ calculate and print *)
  57. var Interest_Payment : real;
  58.     Principal_Payment : real;
  59. begin
  60.    if Balance > 0.0 then begin
  61.       Interest_Payment := Interest_Rate * Balance;
  62.       Principal_Payment := Payment - Interest_Payment;
  63.       if Principal_Payment > Balance then begin  (* loan payed off *)
  64.          Principal_Payment := Balance;              (* this month *)
  65.          Payment := Principal_Payment + Interest_Payment;
  66.          Balance := 0.0;
  67.       end
  68.       else begin  (* regular monthly payment *)
  69.          Balance := Balance - Principal_Payment;
  70.       end;
  71.       Annual_Accum_Interest := Annual_Accum_Interest
  72.                                                + Interest_Payment;
  73.       Writeln(Month:5,Payment:10:2,Interest_Payment:10:2,
  74.               Principal_Payment:10:2,Balance:10:2);
  75.    end; (* of if Balance > 0.0 then *)
  76. end;
  77.  
  78. procedure Print_Annual_Summary; (* ********** print annual summary *)
  79. begin
  80.    Writeln;
  81.    Writeln('Total interest for ',Year:5,' = ',
  82.             Annual_Accum_Interest:10:2);
  83.    Annual_Accum_Interest := 0.0;
  84.    Year := Year + 1;
  85.    Writeln;
  86. end;
  87.  
  88. begin   (* ******************************************* main program *)
  89.    Initialize_Data;
  90.    repeat
  91.       Print_Annual_Header;
  92.       for Month := Starting_Month to 12 do begin
  93.          Calculate_And_Print;
  94.       end;
  95.       Print_Annual_Summary;
  96.       Starting_Month := 1;
  97.    until Balance <= 0.0;
  98. end. (* of main program *)
  99.