[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    program amort;

    { This program does a good job of loan amortization. The original
      author is unknown. I added a procedure to exit the program without
      showing all years for amortization. Richard Odom..VA Beach        }

    const
      MonthTab = 8; {month column}
      PayTab = 14;  {payment column}
      PrinTab = 28; {principle column}
      IntTab = 41;  {interest column}
      BalTab = 53;  {balance column}

    var
      balance, payment, interest, rate, years,
      i1, i2, CurrInt, CurrPrin, ypay, yint, yprin,
      GTPay, GTInt, GTPrin:                            real;
      year, month, line:                            integer;
      borrower:                                  string[32];
      response:                                        char;

    begin
      repeat

        ClrScr;
        write ('Name of borrower: ');
        readln (borrower);
        write ('Amount of loan: ');
        readln (balance);
        write ('Interest rate: ');
        readln (interest);
        i1 := interest/1200 {monthly interest};
        write ('Do you know the monthly payments? ');
        readln (response);

        if UpCase(response) = 'Y'
          then begin
            write ('Payment amount: ');
            readln (payment);
          end
          else begin
            write ('Number of years: ');
            readln (years);
            i2 := exp(ln(i1 + 1) * (12 * years));
            payment := balance * i1 * i2 / (i2 - 1);
            payment := int(payment * 100 + 0.5) / 100;
            writeln ('The monthly payment is $',payment:4:2,'.')
          end;

        write ('Starting year for loan: ');
        readln (year);
        write ('Starting month for loan: ');
        readln (month);
        write ('Press <RETURN> to see monthly totals.');
        readln (response);
        ClrScr; line := 6;
        writeln ('Loan for ',borrower);
        writeln (' Loan of $',balance:4:2,' at ',interest:4:2,'% interest.');
        writeln (' Fixed monthly payments of $',payment:4:2,'.');
        writeln;
        writeln (year:4,'  Month     Payment     Principle     Interest       Balance');
        ypay := 0; yprin := 0; yint := 0;
        GTPay := 0; GTInt := 0; GTPrin := 0; {initialize totals}

        while balance>0 do begin
          CurrInt := int(100 * i1 * balance +0.5) / 100;
          CurrPrin := payment - CurrInt;

          if CurrPrin>balance then begin
            CurrPrin := balance;
            payment := CurrInt + CurrPrin;
          end;

          balance := balance - CurrPrin;
          ypay := ypay + payment; yint := yint + CurrInt; yprin := yprin + CurrPrin;
          GTPay := GTPay + payment; GTInt := GTInt + CurrInt; GTPrin := GTPrin + CurrPrin;
          line := line + 1; GotoXY(MonthTab,line);
          write (month:2); GotoXY(PayTab,line);
          write (payment:10:2); GotoXY(PrinTab,line);
          write (CurrPrin:10:2); GotoXY(IntTab,line);
          write (CurrInt:10:2); GotoXY(BalTab,line);
          writeln (balance:12:2);
          month := month + 1;

          if (month>12) or (balance=0.0) then begin
            writeln; line := line + 2;
            write (year:4,' Total'); GotoXY(PayTab,line);
            write (ypay:10:2); GotoXY(PrinTab,line);
            write (yprin:10:2); GotoXY(IntTab,line);
            write (yint:10:2); GotoXY(BalTab,line);
            writeln (balance:12:2);
            year := year + 1;
            month := 1;
            ypay := 0; yprin := 0; yint := 0;

            if balance>0 then begin
              writeln;
              writeln ('Press <RETURN> to see ',year:4,'.');
              write('Enter Q to end program  ');
              readln (response);
              If upcase(response)='Q' then
               halt;
              ClrScr; line := 2; writeln (year:4,'  Month     Payment     Principle     Interest       Balance');
            end;

          end;

        end; {while}

        writeln; line := line + 2;
        write ('Grand Total'); GotoXY(PayTab,line);
        write (GTPay:10:2); GotoXY(PrinTab,line);
        write (GTPrin:10:2); GotoXY(IntTab,line);
        write (GTInt:10:2); GotoXY(BalTab,line);
        writeln (balance:12:2);
        writeln;
        write ('Do you wish to start over? ');
        readln (response);

      until UpCase(response)='N';

    end.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]