home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / a / amortize.lbr / AMORTIZE.PZS / AMORTIZE.PAS
Encoding:
Pascal/Delphi Source File  |  1993-03-04  |  3.4 KB  |  152 lines
  1. program AMORTIZE;
  2.  
  3. {see amortcpm.doc}
  4.  
  5. const COLUMN_POSITION = 56;
  6.       ROW_OFFSET = 9;
  7.  
  8. var INPUT : array[1..4] of string[10];
  9.     FIELD : integer;
  10.     RESPONSE : char;
  11.     COLUMN : integer;
  12.     ACTIVE : Boolean;
  13.     RESET_MESSAGE : Boolean;
  14.     AMOUNT : real;
  15.     MONTHS : integer;
  16.     RATE : real;
  17.     PAYMENT : real;
  18.  
  19. {$IAMORT1.INC}
  20. {$IAMORT2.INC}
  21.  
  22. procedure Compute_Amount;
  23.  
  24. var HOLD : real;
  25.  
  26. begin
  27.  
  28.   HOLD := POWER(1.0 + (RATE / 1200.0),MONTHS);
  29.   AMOUNT := (PAYMENT * (HOLD - 1.0)) / ((RATE / 1200.0) * HOLD);
  30.   HOLD := frac(AMOUNT*100.0);
  31.   AMOUNT := ((AMOUNT*100.0)-HOLD)/100.0;
  32.  
  33. end;
  34.  
  35. procedure Compute_Months;
  36.  
  37. var M_RATE, PRINCIPAL : real;
  38.  
  39. begin
  40.  
  41.   M_RATE := RATE / 1200;
  42.   PRINCIPAL := AMOUNT;
  43.   MONTHS := 0;
  44.   while PRINCIPAL > 0.0 do begin
  45.     PRINCIPAL := PRINCIPAL - (PAYMENT - PRINCIPAL * M_RATE);
  46.     MONTHS := MONTHS + 1;
  47.   end;
  48.  
  49. end;
  50.  
  51. procedure Compute_Rate;
  52.  
  53. var HOLD_1, HOLD_2, HOLD_1_PART, HOLD_2_PART : real;
  54.  
  55. begin
  56.  
  57.   RATE := 1200.0 * PAYMENT / AMOUNT - 0.01;
  58.  
  59.   repeat
  60.     RATE := RATE + 0.001;
  61.     HOLD_1_PART := POWER(1.0 + RATE / 1200.0, MONTHS);
  62.     HOLD_2_PART := POWER(1.0 + (RATE + 0.001) / 1200.0, MONTHS);
  63.     HOLD_1 := RATE / 1200.0 * AMOUNT * HOLD_1_PART /
  64.         (HOLD_1_PART - 1.0);
  65.     HOLD_2 := (RATE + 0.001) / 1200.0 * AMOUNT * HOLD_2_PART /
  66.         (HOLD_2_PART - 1.0);
  67.     if (HOLD_1 > PAYMENT) and (HOLD_2 > PAYMENT) then
  68.       RATE := RATE - 0.1;
  69.   until (PAYMENT > HOLD_1) and (PAYMENT < HOLD_2);
  70.   RATE := RATE+0.005;
  71.   HOLD_1 := frac(RATE*100.0);
  72.   RATE := ((RATE*100.0)-HOLD_1)/100.0;
  73.  
  74. end;
  75.  
  76. procedure Compute_Payment;
  77.  
  78. var HOLD : real;
  79.  
  80. begin
  81.  
  82.   HOLD := Power(1.0 + RATE / 1200.0, MONTHS);
  83.   PAYMENT := ((RATE / 1200.0) * HOLD * AMOUNT) / (HOLD - 1.0);
  84.   PAYMENT := PAYMENT+0.005;
  85.   HOLD := frac(PAYMENT*100.0);
  86.   PAYMENT := ((PAYMENT*100.0)-HOLD)/100.0;
  87.  
  88. end;
  89.  
  90. procedure Do_Amortization;
  91.  
  92. begin
  93.  
  94.   if (AMOUNT <= 0.0) and (MONTHS > 0) and
  95.       (RATE > 0.0) and (PAYMENT > 0.0) then begin
  96.     Compute_Amount;
  97.     gotoxy(COLUMN_POSITION-12,ROW_OFFSET+1);
  98.     write(AMOUNT:9:2,'           ');
  99.     Display_Amortization;
  100.   end
  101.   else
  102.     if (AMOUNT > 0.0) and (MONTHS <= 0) and
  103.         (RATE > 0.0) and (PAYMENT > 0.0) then begin
  104.       Compute_Months;
  105.       gotoxy(COLUMN_POSITION-12,ROW_OFFSET+2);
  106.       write(MONTHS:9,'           ');
  107.       Display_Amortization;
  108.     end
  109.     else
  110.       if (AMOUNT > 0.0) and (MONTHS > 0) and
  111.           (RATE <= 0.0) and (PAYMENT > 0.0) then begin
  112.         Compute_Rate;
  113.         gotoxy(COLUMN_POSITION-12,ROW_OFFSET+3);
  114.         write(RATE:9:2,'           ');
  115.         Display_Amortization;
  116.       end
  117.       else
  118.         if (AMOUNT > 0.0) and (MONTHS > 0) and (RATE > 0.0) then begin
  119.           Compute_Payment;
  120.           gotoxy(COLUMN_POSITION-12,ROW_OFFSET+4);
  121.           write(PAYMENT:9:2,'            ');
  122.           Display_Amortization;
  123.         end
  124.         else begin
  125.           gotoxy(6,23);
  126.           write('You must define values > 0 for at least three fields. ');
  127.           RESET_MESSAGE := true;
  128.         end;
  129.  
  130. end;
  131.  
  132. {$IAMORT3.INC}
  133.  
  134. begin { main procedure }
  135.  
  136.   AMOUNT := 0.0;
  137.   MONTHS := 0;
  138.   RATE := 0.0;
  139.   PAYMENT := 0.0;
  140.   Draw_Screen;
  141.   for FIELD := 1 to 4 do begin
  142.     INPUT[FIELD] := '0';
  143.     ACTIVE := true;
  144.     Set_Field;
  145.   end;
  146.   FIELD := 1;
  147.   New_Position;
  148.   Process_Input;
  149.   clrscr;
  150.  
  151. end.
  152.