home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd558 / amoner2 / loancalc.amos / loancalc.amosSourceCode
AMOS Source Code  |  1993-11-29  |  5KB  |  239 lines
  1. Set Buffer 30
  2. Fix(2)
  3. On Error Proc BOOBOO
  4. Rem defeat Intital output window 
  5. INIT:
  6. Dim SCH#(600,3)
  7. Global SCH#()
  8. STATUSLINE=21
  9. Def Fn PMT#(L#,M,I#)=L#/((1.0-(1.0+I#)^-M)/I#)
  10. T1$="The Loan Calculator"
  11. T2$="Presented by: Admiralty Software Engineering"
  12. T3$="This AMOS port was brought to you by The AMONER Project"
  13. Screen Open 0,640,200,16,Hires
  14. Wind Open 1,0,0,78,24,1
  15. Title Top "The Loan Calculator Created by: Ira S. Davis ï¿½1985-1991"
  16. Title Bottom "Ported from HiSoft BASIC to AMOS by Michael Cox"
  17. TXT=4
  18. MSG=9
  19. OLDNMBRS=5
  20. NEWNMBRS=6
  21. Palette 0,0,,0,,,,,,$FF0
  22. MAIN:
  23. Pen TXT
  24. Clw 
  25. Curs Off 
  26. Centre T1$
  27. Cmove ,2
  28. Centre T2$
  29. SETVALUES
  30. Locate 1,5
  31. Pen TXT
  32. Print "Amount of Loan"
  33. Locate 32,5
  34. Pen OLDNMBRS
  35. Print AMT#
  36. Locate 31,5
  37. Curs On 
  38. Input AMT#
  39. Locate 1,6
  40. Pen TXT
  41. Print "Annual Percentage Rate (APR)"
  42. Locate 32,6
  43. Pen OLDNMBRS
  44. Print APR#
  45. Locate 31,6
  46. Input APR#
  47. Locate 1,7
  48. Pen TXT
  49. Print "Term of Loan (Years)"
  50. Locate 32,7
  51. Pen OLDNMBRS
  52. Print YRS
  53. Locate 31,7
  54. Input YRS
  55. SETVALUES
  56. Locate 1,9
  57. Pen TXT
  58. Curs Off 
  59. Set Tab 15
  60. Print "Loan Amt";Tab$;
  61. Set Tab 30 : Print "APR";Tab$;"Term";
  62. Set Tab 45 : Print Tab$;"Payments"
  63. PAY#= Fn PMT#(L#,M,I#)
  64. Pen OLDNMBRS
  65. Print AMT#
  66. Locate 15,10
  67. Print Using "##.# %";APR#
  68. Locate 30,10
  69. Print Using "## Yrs";YRS
  70. Locate 45,10
  71. Pen NEWNMBRS
  72. Print Using "$######.##";PAY#
  73. Locate 1,12
  74. Pen TXT
  75. Set Tab 30
  76. Print "Total Payback";Tab$;"Interest Paid"
  77. Pen NEWNMBRS
  78. Print Using "$######.##";PAY#*M
  79. Locate 30,13
  80. Print Using "$######.##";(PAY#*M)-AMT#
  81. Locate 1,STATUSLINE : Centre Space$(40)
  82. Pen MSG
  83. Curs Off 
  84. Centre "View Loan Amortization Schedule?  Y/N"
  85. A$=""
  86. While(A$<>"Y") and(A$<>"N")
  87.    A$=Upper$(Inkey$)
  88. Wend 
  89. Curs Off 
  90. If A$="Y"
  91.    AMORTIZE
  92. End If 
  93. Locate 1,STATUSLINE
  94. Pen MSG
  95. Centre Space$(40) : Locate 1,STATUSLINE
  96. Centre "Calculate Another Loan?  Y/N"
  97. A$=""
  98. While(A$<>"Y") and(A$<>"N")
  99.    A$=Upper$(Inkey$)
  100. Wend 
  101. If A$="N"
  102.    Locate 1,STATUSLINE
  103.    Centre Space$(40)
  104.    Pen TXT
  105.    Locate 1,STATUSLINE
  106.    Centre T3$
  107.    Wait 250
  108.    Wind Close 
  109.    Screen Close 0
  110.    Run "autoexec.amos"
  111. Else 
  112.    Goto MAIN
  113. End If 
  114. Procedure AMORTIZE
  115.    Shared PAY#,YRS,M,STATUSLINE,TXT,OLDNMBRS,NEWNMBRS,MSG
  116.    Clw 
  117.    Pen TXT
  118.    Set Tab 36
  119.    Print "Amortization Schedule for Year";Tab$;"of ";
  120.    Pen OLDNMBRS
  121.    Print YRS
  122.    Locate 50,1
  123.    Pen TXT
  124.    Print "Payments = "
  125.    Locate 61,1
  126.    Pen OLDNMBRS
  127.    Print Using "$######.##";PAY#
  128.    CALCSCHEDULE
  129.    Locate 1,3
  130.    Pen TXT
  131.    Set Tab 15
  132.    Print "Month";Tab$;"Interest";
  133.    Set Tab 30 : Print Tab$;"Principle";
  134.    Set Tab 45 : Print Tab$;"Balance"
  135.    For X=1 To YRS
  136.       PTOTAL#=0
  137.       ITOTAL#=0
  138.       Locate 32,0
  139.       Pen NEWNMBRS
  140.       Print Using "###";X
  141.       For Y=1 To 12
  142.          NDX=((X-1)*12)+Y
  143.          Locate 1,Y+4
  144.          Pen OLDNMBRS
  145.          Print Y
  146.          Locate 15,Y+4
  147.          Print Using "$######.##";SCH#(NDX,1)
  148.          Locate 30,Y+4
  149.          Print Using "$######.##";SCH#(NDX,2)
  150.          Locate 45,Y+4
  151.          Print Using "$######.##";SCH#(NDX,3)
  152.          ITOTAL#=ITOTAL#+SCH#(NDX,1)
  153.          PTOTAL#=PTOTAL#+SCH#(NDX,2)
  154.       Next Y
  155.       Locate 1,Y+5
  156.       Pen TXT
  157.       Print "YTD Totals"
  158.       Locate 15,Y+5
  159.       Pen NEWNMBRS
  160.       Print Using "$######.##";ITOTAL#
  161.       Locate 30,Y+5
  162.       Print Using "$######.##";PTOTAL#
  163.       If NDX=M
  164.          Locate 1,Y+6
  165.          Pen TXT
  166.          Print "Final Payment is"
  167.          FINAL#=SCH#(M,1)+SCH#(M,2)
  168.          Locate 30,Y+6
  169.          Pen NEWNMBRS
  170.          Print Using "$######.##";FINAL#
  171.       End If 
  172.       Locate 1,STATUSLINE
  173.       Pen MSG
  174.       Centre "Any key to continue"
  175.       Wait Key 
  176.       Locate 1,STATUSLINE
  177.       Centre Space$(40)
  178.    Next X
  179. End Proc
  180. Procedure CALCSCHEDULE
  181.    Shared M,AMT#,I#,PAY#
  182.    BALANCE#=AMT#
  183.    For NDX=1 To M-1
  184.       SCH#(NDX,1)=I#*BALANCE#
  185.       SCH#(NDX,2)=PAY#-SCH#(NDX,1)
  186.       BALANCE#=BALANCE#-SCH#(NDX,2)
  187.       SCH#(NDX,3)=BALANCE#
  188.    Next 
  189.    SCH#(M,1)=SCH#(M-1,3)*I#
  190.    SCH#(M,2)=SCH#(M-1,3)
  191.    SCH#(M,3)=0
  192. End Proc
  193. Procedure SETVALUES
  194.    Shared AMT#,L#,APR#,I#,YRS,M
  195.    If AMT#<>0
  196.       L#=AMT#
  197.    End If 
  198.    If L#=0
  199.       L#=1000.0
  200.       AMT#=1000.0
  201.    End If 
  202.    If AMT#=0.0
  203.       AMT#=L#
  204.    End If 
  205.    If APR#<>0.0
  206.       I#=APR#/1200.0
  207.    End If 
  208.    If I#=0.0
  209.       I#=12.0/1200.0
  210.       APR#=12.0
  211.    End If 
  212.    If APR#=0.0
  213.       APR#=I#*1200.0
  214.    End If 
  215.    If YRS<>0
  216.       M=YRS*12
  217.    End If 
  218.    If M=0
  219.       M=12
  220.       YRS=1
  221.    End If 
  222.    If YRS=0
  223.       YRS=M/12
  224.    End If 
  225. End Proc
  226. Procedure BOOBOO
  227.    Clw 
  228.    E=Errn
  229.    If E=9
  230.       Centre "Control-C Pressed. . . Exiting. . ."
  231.       Wait 150
  232.       Run "autoexec.amos"
  233.    End If 
  234.    Centre "Error Number "+Str$(E)+" encountered"
  235.    Cdown : Centre "Please report this to Michael Cox"
  236.    Cdown : Centre "See Doc/Amoner002.Doc for contact info"
  237.    Wait 250
  238.    Run "autoexec.amos"
  239. End Proc