home *** CD-ROM | disk | FTP | other *** search
/ The Best of the Best / _.img / 02001 / rendite.inc < prev    next >
Text File  |  1989-01-03  |  12KB  |  431 lines
  1.  
  2. (* Rendite.inc *)
  3.  
  4. (* Prozeduren zur Renditenberechnung von Anleihen *)
  5.  
  6. (*--------------------------------------------------------------------------*)
  7.  
  8. procedure Bildschirm_3; forward;
  9.  
  10. (*--------------------------------------------------------------------------*)
  11.  
  12.               (* Renditenberechnung von Zinsanleihen *)
  13.  
  14. procedure Rendite_Zinsanleihe;
  15. begin
  16. clrscr;
  17. textbackground(red);
  18. writeln(' Ausgabekurs der Zinsanleihe in %  :  ');
  19. Eingabe_Pruefen(    1);
  20. if ioresult <> 0 then
  21.   begin
  22.    Fehlermeldung;
  23.    Bildschirm_3;
  24.   end
  25. else
  26.  begin
  27.   Schaetzkurse(1);
  28.   if (ko<kurs) and (ko1>kurs) then
  29.     begin
  30.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  31.      Rendite:=p2+diff;
  32.      Writeln(cr,cr,' Die Rendite der Zinsanleihe beträgt ',Rendite:2:3,' % ');
  33.     end
  34.   else
  35.    if (ko>kurs) and (ko1<kurs) then
  36.      begin
  37.       diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  38.       Rendite:=p1+diff;
  39.       writeln(cr,cr,' Die Rendite der Zinsanleihe beträgt ',Rendite:2:3,' % ');
  40.      end
  41.    else Fehlermeldung;
  42.   Abfrage_Neuberechnen;
  43.   if Auswahl in [ 'J', 'j' ] then Rendite_Zinsanleihe else Bildschirm_3;
  44.  end;
  45. end;
  46.  
  47. (*--------------------------------------------------------------------------*)
  48.  
  49.                (* Mindestrendite einer Ratenanleihe *)
  50.  
  51. procedure Mindest_Rendite_Ratenanleihe;
  52. begin
  53. clrscr;
  54. textbackground(red);
  55. writeln(' Ausgabekurs der Ratenanleihe in % :  ');
  56. Eingabe_Pruefen(1);
  57. if ioresult <> 0 then
  58.   begin
  59.     Fehlermeldung;
  60.     Bildschirm_3;
  61.   end
  62.  else
  63.   begin
  64.    Schaetzkurse(3);
  65.    if (ko<kurs) and (ko1>kurs) then
  66.     begin
  67.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  68.      Rendite:=p2+diff;
  69.      Writeln(cr,cr,' Die Mindestrendite der Ratenanleihe beträgt ',Rendite:2:3,' % ');
  70.     end
  71.   else
  72.    if (ko>kurs) and (ko1<kurs) then
  73.     begin
  74.      diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  75.      Rendite:=p1+diff;
  76.      writeln(cr,cr,' Die Mindestrendite der Ratenanleihe beträgt ',Rendite:2:3,' % ');
  77.     end
  78.   else Fehlermeldung;
  79.   Abfrage_Neuberechnen;
  80.   if Auswahl in [ 'J', 'j' ] then Mindest_Rendite_Ratenanleihe else Bildschirm_3;
  81.  end;
  82. end;
  83.  
  84. (*--------------------------------------------------------------------------*)
  85.  
  86.                (* Höchstrendite einer Ratenanleihe *)
  87.  
  88. procedure Hoechst_Rendite_Ratenanleihe;
  89. begin
  90. clrscr;
  91. textbackground(red);
  92. writeln(' Ausgabekurs der Ratenanleihe in % :  ');
  93. Eingabe_Pruefen(1);
  94. if ioresult <> 0 then
  95.   begin
  96.     Fehlermeldung;
  97.     Bildschirm_3;
  98.   end
  99.  else
  100.   begin
  101.    t:=1;
  102.    Schaetzkurse(3);
  103.    if (ko<kurs) and (ko1>kurs) then
  104.     begin
  105.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  106.      Rendite:=p2+diff;
  107.      Writeln(cr,cr,' Die Höchstrendite der Ratenanleihe beträgt ',Rendite:2:3,' % ');
  108.     end
  109.   else
  110.    if (ko>kurs) and (ko1<kurs) then
  111.     begin
  112.      diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  113.      Rendite:=p1+diff;
  114.      writeln(cr,cr,' Die Höchstrendite der Ratenanleihe beträgt ',Rendite:2:3,' % ');
  115.     end
  116.   else Fehlermeldung;
  117.   Abfrage_Neuberechnen;
  118.   if Auswahl in [ 'J', 'j' ] then Hoechst_Rendite_Ratenanleihe else Bildschirm_3;
  119.  end;
  120. end;
  121.  
  122. (*--------------------------------------------------------------------------*)
  123.  
  124.                   (* Gesamtrendite einer Ratenanleihe *)
  125.  
  126. procedure Gesamt_Rendite_Ratenanleihe;
  127. begin
  128. clrscr;
  129. textbackground(red);
  130. writeln(' Ausgabekurs der Ratenanleihe in % :  ');
  131. Eingabe_Pruefen(1);
  132. if ioresult <> 0 then
  133.   begin
  134.     Fehlermeldung;
  135.     Bildschirm_3;
  136.   end
  137.  else
  138.   begin
  139.    t:=round(t/2);
  140.    Schaetzkurse(3);
  141.    if (ko<kurs) and (ko1>kurs) then
  142.     begin
  143.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  144.      Rendite:=p2+diff;
  145.      Writeln(cr,cr,' Die Durchschnittsrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  146.     end
  147.   else
  148.    if (ko>kurs) and (ko1<kurs) then
  149.     begin
  150.      diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  151.      Rendite:=p1+diff;
  152.      writeln(cr,cr,' Die Durchschnittsrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  153.     end
  154.   else
  155.   Fehlermeldung;
  156.   Abfrage_Neuberechnen;
  157.   if Auswahl in [ 'J', 'j' ] then Gesamt_Rendite_Ratenanleihe else Bildschirm_3;
  158.  end;
  159. end;
  160.  
  161. (*--------------------------------------------------------------------------*)
  162.  
  163.         (* Höchstrendite einer aufgeschobenen Ratenanleihe *)
  164.  
  165. procedure Hoechst_Rendite_Ratenanleihe_1;
  166. begin
  167. clrscr;
  168. textbackground(red);
  169. Eingabe_Pruefen(0);
  170. if ioresult <> 0 then
  171.   begin
  172.     Fehlermeldung;
  173.     Bildschirm_3;
  174.   end
  175.  else
  176.   begin
  177.    t:=t-ti+1;
  178.    Schaetzkurse(1);
  179.    if (ko<kurs) and (ko1>kurs) then
  180.     begin
  181.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  182.      Rendite:=p2+diff;
  183.      Writeln(cr,cr,' Die Höchstrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  184.     end
  185.   else
  186.    if (ko>kurs) and (ko1<kurs) then
  187.      begin
  188.       diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  189.       Rendite:=p1+diff;
  190.       writeln(cr,cr,' Die Höchstrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  191.      end
  192.    else
  193.     Fehlermeldung;
  194.     Abfrage_Neuberechnen;
  195.     if Auswahl in [ 'J', 'j' ] then Hoechst_Rendite_Ratenanleihe_1 else Bildschirm_3;
  196.    end;
  197. end;
  198.  
  199. (*--------------------------------------------------------------------------*)
  200.  
  201.              (* Mindestrendite einer aufgeschobenen Ratenanleihe *)
  202.  
  203. procedure Mindest_Rendite_Ratenanleihe_1;
  204. begin
  205. clrscr;
  206. textbackground(red);
  207. Eingabe_Pruefen(0);
  208. if ioresult <> 0 then
  209.   begin
  210.     Fehlermeldung;
  211.     Bildschirm_3;
  212.   end
  213.  else
  214.   begin
  215.    Schaetzkurse(1);
  216.    if (ko<kurs) and (ko1>kurs) then
  217.     begin
  218.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  219.      Rendite:=p2+diff;
  220.      Writeln(cr,cr,' Die Mindestrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  221.     end
  222.   else
  223.    if (ko>kurs) and (ko1<kurs) then
  224.      begin
  225.       diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  226.       Rendite:=p1+diff;
  227.       writeln(cr,cr,' Die Mindestrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  228.      end
  229.    else
  230.     Fehlermeldung;
  231.     Abfrage_Neuberechnen;
  232.     if Auswahl in [ 'J', 'j' ] then Mindest_Rendite_Ratenanleihe_1 else Bildschirm_3;
  233.    end;
  234. end;
  235.  
  236. (*--------------------------------------------------------------------------*)
  237.  
  238.             (* Gesamtrendite einer aufgeschobenen Ratenanleihe *)
  239.  
  240. procedure Gesamt_Rendite_Ratenanleihe_1;
  241. begin
  242. clrscr;
  243. textbackground(red);
  244. Eingabe_Pruefen(0);
  245. if ioresult <> 0 then
  246.   begin
  247.     Fehlermeldung;
  248.     Bildschirm_3;
  249.   end
  250.  else
  251.   begin
  252.    t :=round(((t-ti)/2)+ ti);
  253.    Schaetzkurse(1);
  254.    if (ko<kurs) and (ko1>kurs) then
  255.     begin
  256.      diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  257.      Rendite:=p2+diff;
  258.      Writeln(cr,cr,' Die Durchschnittsrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  259.     end
  260.   else
  261.    if (ko>kurs) and (ko1<kurs) then
  262.      begin
  263.       diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  264.       Rendite:=p1+diff;
  265.       writeln(cr,cr,' Die Durchschnittsrendite der Ratenanleihe beträgt ',Rendite:2:3,' %');
  266.      end
  267.    else
  268.     Fehlermeldung;
  269.     Abfrage_Neuberechnen;
  270.     if Auswahl in [ 'J', 'j' ] then Gesamt_Rendite_Ratenanleihe_1 else Bildschirm_3;
  271.    end;
  272. end;
  273.  
  274. (*--------------------------------------------------------------------------*)
  275.  
  276.             (* Höchstrendite einer Annuitätenanleihe *)
  277.  
  278. procedure Hoechst_Rendite_Annuitaetenanleihe;
  279. begin
  280. clrscr;
  281. textbackground(red);
  282. Eingabe_Pruefen(2);
  283. if ioresult <> 0 then
  284.   begin
  285.     Fehlermeldung;
  286.     Bildschirm_3;
  287.   end
  288.  else
  289.   begin
  290.   t:=1;
  291.   Schaetzkurse(2);
  292. if (ko<kurs) and (ko1>kurs) then begin
  293.   diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  294.   Rendite:=p2+diff;
  295.   Writeln(cr,cr,' Die Höchstrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  296. end
  297. else
  298. if (ko>kurs) and (ko1<kurs) then begin
  299.   diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  300.   Rendite:=p1+diff;
  301.   writeln(cr,cr,' Die Höchstrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  302. end
  303. else
  304. Fehlermeldung;
  305.     Abfrage_Neuberechnen;
  306.     if Auswahl in [ 'J', 'j' ] then Hoechst_Rendite_Annuitaetenanleihe else Bildschirm_3;
  307.    end;
  308. end;
  309.  
  310. (*--------------------------------------------------------------------------*)
  311.  
  312.                (* Mindestrendite einer Annuitätenanleihe *)
  313.  
  314. procedure Mindest_Rendite_Annuitaetenanleihe;
  315. begin
  316. clrscr;
  317. textbackground(red);
  318. Eingabe_Pruefen(2);
  319. if ioresult <> 0 then
  320.   begin
  321.     Fehlermeldung;
  322.     Bildschirm_3;
  323.   end
  324.  else
  325.   begin
  326.   Schaetzkurse(2);
  327. if (ko<kurs) and (ko1>kurs) then begin
  328.   diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  329.   Rendite:=p2+diff;
  330.   Writeln(cr,cr,' Die Mindestrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  331. end
  332. else
  333. if (ko>kurs) and (ko1<kurs) then begin
  334.   diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  335.   Rendite:=p1+diff;
  336.   writeln(cr,cr,' Die Mindestrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  337. end
  338. else
  339. Fehlermeldung;
  340.     Abfrage_Neuberechnen;
  341.     if Auswahl in [ 'J', 'j' ] then Mindest_Rendite_Annuitaetenanleihe else Bildschirm_3;
  342.    end;
  343. end;
  344.  
  345. (*--------------------------------------------------------------------------*)
  346.  
  347.             (* Gesamtrendite einer Annuitätenanleihe *)
  348.  
  349. procedure Gesamt_Rendite_Annuitaetenanleihe;
  350. begin
  351. clrscr;
  352. textbackground(red);
  353. Eingabe_Pruefen(2);
  354. if ioresult <> 0 then
  355.   begin
  356.     Fehlermeldung;
  357.     Bildschirm_3;
  358.   end
  359.  else
  360.   begin
  361.    q  :=1+(p/100);
  362.    q1 :=1+(p1/100);
  363.    qn :=exp(ln(q)*t);
  364.    qn1:=exp(ln(q1)*t);
  365.    an :=(qn-1)/(qn*(q-1));
  366.    an1:=(qn1-1)/(qn1*(q1-1));
  367.    ko :=100*(an1/an);
  368.    writeln(cr,' 1. geschätzter Ausgabekurs             : ',ko:2:3,' % ',cr);
  369.    write(' 2. Schätzung der Rendite in %          : ');
  370.    read(p2);
  371.    q2 :=1+(p2/100);
  372.    qn2:=exp(ln(q2)*t);
  373.    an2:=(qn2-1)/(qn2*(q2-1));
  374.    ko1:=100*(an2/an);
  375.   if (ko<kurs) and (ko1>kurs) then begin
  376.    diff:=(p1-p2)*(ko1-kurs)/(ko1-ko);
  377.    Rendite:=p2+diff;
  378.    Writeln(cr,cr,' Die Durschnittsrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  379.   end
  380. else
  381. if (ko>kurs) and (ko1<kurs) then begin
  382.   diff:=(p2-p1)*(ko-kurs)/(ko-ko1);
  383.   Rendite:=p1+diff;
  384.   writeln(cr,cr,' Die Durchschnittsrendite der Annuitätenanleihe beträgt ',Rendite:2:3,' % ');
  385. end
  386. else
  387. Fehlermeldung;
  388.     Abfrage_Neuberechnen;
  389.     if Auswahl in [ 'J', 'j' ] then Gesamt_Rendite_Annuitaetenanleihe else Bildschirm_3;
  390.    end;
  391. end;
  392. (*--------------------------------------------------------------------------*)
  393.  
  394.                (* Bildschirmmaske zur Renditenberechnung *)
  395.  
  396. procedure Bildschirm_3;
  397. begin
  398.   window(2,5,75,23);
  399.   clrscr;
  400.   write('                           RENDITENRECHNUNG');
  401.   write(cr,cr,'            Rendite einer Zinsanleihe                    =  1');
  402.   write(cr,cr,'            Mindestrendite einer Ratenanleihe            =  2');
  403.   write(cr,'            Höchstrendite einer Ratenanleihe             =  3');
  404.   write(cr,'            Durchschnittsrendite einer Ratenanleihe      =  4');
  405.   write(cr,'            Mindestrendite/tilgungsfreie Ratenanleihe    =  5');
  406.   write(cr,'            Höchstrendite/tilgungsfreie Ratenanleihe     =  6');
  407.   write(cr,'            Durchschnittsrendite/tilgungsfr.Ratenanleihe =  7');
  408.   write(cr,cr,'            Mindestrendite einer Annuitätenanleihe       =  8');
  409.   write(cr,'            Höchstrendite einer Annuitätenanleihe        =  9');
  410.   write(cr,'            Durchschnittsrendite einer Annuitätenanleihe =  0');
  411.   write(cr,cr,'            Zurück zur Hauptauswahl                      =  H');
  412.   write(cr,cr,cr,'            Wählen und mit <Return> bestätigen           :  ');
  413. repeat
  414.   read(TasteB);
  415.   Tastencode:=Ord(TasteB);
  416.   case tastencode of
  417.     49 : Rendite_Zinsanleihe;
  418.     50 : Mindest_Rendite_Ratenanleihe;
  419.     51 : Hoechst_Rendite_Ratenanleihe;
  420.     52 : Gesamt_Rendite_Ratenanleihe;
  421.     53 : Mindest_Rendite_Ratenanleihe_1;
  422.     54 : Hoechst_Rendite_Ratenanleihe_1;
  423.     55 : Gesamt_Rendite_Ratenanleihe_1;
  424.     56 : Mindest_Rendite_Annuitaetenanleihe;
  425.     57 : Hoechst_Rendite_Annuitaetenanleihe;
  426.     48 : Gesamt_Rendite_Annuitaetenanleihe;
  427.     72,104 : Bildschirm;
  428.   end (*von case*)
  429. until Tastencode in [ 72, 104 ];
  430. end;
  431.