home *** CD-ROM | disk | FTP | other *** search
/ Best of German Only 1 / romside_best_of_german_only_1.iso / finanzen / jz / pack8.exe / FINTV.PAS < prev   
Pascal/Delphi Source File  |  1993-03-08  |  21KB  |  777 lines
  1. program finTV ;
  2.   { Programm mit Turbo Vision 2.0   1.3.93 }
  3.  
  4. uses Drivers, Objects, Views, Menus,
  5.      App, MsgBox, Editors, StdDlg, Dialogs, Validate,
  6.      finanzl ;
  7.  
  8.   {    *******************************
  9.        J Z - F I N A N Z M A T H E  Vers. 1.1  8.3.1993
  10.        eine Toolbox für Finanzmathematik in Borland Pascal
  11.        Alle Rechte bei:  Karl Jenz
  12.                          7302 Ostfildern 1 Horbstr.7
  13.  
  14.        *** Demoprogramme zur Anwendung der Toolbox
  15.            mit Turbo Vision 2.0 von Borland Pascal **
  16.  
  17.          ****************************** }
  18.  
  19.  
  20. CONST
  21.  
  22. { Konstanten für Kommandos und Hilfen: }
  23.  
  24. cmBildsch = 111 ;
  25. cmDrucker = 112 ;
  26.  
  27.  
  28. cmDarl  = 1001 ;
  29. cmTilg = 1010 ;
  30. cmRatenKr = 1020 ;
  31.  
  32. cmEinmal = 2001 ;
  33. cmEinmWinDa = 2002 ;
  34. cmRatenSp = 2010 ;
  35. cmRatenSpWinDa = 2011 ;
  36. cmSonderSp = 2020 ;
  37. cmWertp = 2030 ;
  38.  
  39. hcHilfen = 5800 ;  { Hilfe bei Dialogen }
  40.  
  41. hcDarl = 6001 ;
  42. hcTilg = 6010 ;
  43. hcRatenKr = 6020 ;
  44.  
  45. hcEinmal = 7001 ;
  46. hcRatenSp = 7010 ;
  47. hcSonderSp = 7020 ;
  48. hcWertp = 7030 ;
  49.  
  50.  
  51.  
  52.   RealCharSet = ['-',',','.','0'..'9'] ;
  53.    { zulässige Eingabezeichen bei Real }
  54.  
  55.   MsgNoHelp = 'Hilfen noch nicht programmiert.' ;
  56.   MsgNo = 'Noch nicht programmiert.' ;
  57.   MsgFehler = 'Fehlerhafte Eingaben' ;
  58.   MsgDemo = '*Demoprogramm JZ-Finanzmathe*' ;
  59.  
  60. TYPE
  61.  
  62. str11 = string[11] ;
  63. str15 = string[15] ;
  64. str250 = string[250] ;
  65.  
  66. TEinm = record  { Eingabe der Zahlen }
  67.   kap0, zinsPr, monate, kap1 : str11 ;
  68.   periode, berechng : Word ;
  69.   end ;
  70.  
  71. TEinm2 = record   { Rechenwerte der eingegebenen Zahlen }
  72.    kap0, zinsPr, kap1 : real ;
  73.    monate, periode : integer ;  { Umgewandelte Periode in Rechenwert }
  74.    end;
  75.  
  76. TRaten = record  { Eingabe der Zahlen bei Ratensparen }
  77.    rate, zinsPr, anzahl : str11 ;
  78.    ratenPer, zinsPer : Word ; { Ratenperiode und Zinsperiode }
  79.   end;
  80.  
  81. TRaten2 = record { Rechenwerte aus TRaten }
  82.   rate, zinsPr, endkap : real ;
  83.   anzahl, ratenPer, zinsPer : integer ;
  84.  end;
  85.  
  86.  
  87. PRealValidator = ^TRealValidator ;
  88. TRealValidator = object ( TFilterValidator )
  89.    { speziell für Realeingaben abgeleitetes Kontrollinstrument }
  90.   constructor Init ( AValidChars : TCharSet );
  91.   function IsValidInput ( var S : String ;
  92.             NoAutoFill : boolean ) : Boolean ; virtual ;
  93.   end ;
  94.  
  95. TMyDialog = object ( TDialog )
  96.   constructor Init ( var Bounds : TRect ; ATitle : TTitleStr );
  97.   procedure HandleEvent ( var Event : TEvent ) ; virtual ;
  98.   end;
  99.  
  100.  
  101. PEinmWindow = ^TEinmWindow ;
  102. TEinmWindow = object ( TMyDialog )
  103.     Einm2 : TEinm2 ; { Eingaben als Rechenwerte }
  104.     constructor Init ;
  105.     function berechnen : boolean ;
  106.         { gibt True zurück, wenn Eingaben ok waren und
  107.           Ergebnis berechnet werden konnte. }
  108.     procedure HandleEvent ( var Event : TEvent ) ; virtual ;
  109.     end;
  110.  
  111. PRatenWindow = ^TRatenWindow ;
  112. TRatenWindow = object ( TMyDialog )
  113.     Raten2 : TRaten2 ; { Eingaben als Rechenwerte }
  114.     constructor Init ;
  115.     function berechnen : boolean ;
  116.         { gibt True zurück, wenn Eingaben ok waren und
  117.           Ergebnis berechnet werden konnte. }
  118.     procedure HandleEvent ( var Event : TEvent ) ; virtual ;
  119.     end;
  120.  
  121.  
  122. TMyApp = object ( TApplication )
  123.       EinmWindow : PEinmWindow ;
  124.       RatenSpWindow : PRatenWindow ;
  125.       constructor Init ;
  126.       procedure NochNicht ;  { Noch nicht programmiert }
  127.       procedure HandleEvent ( var Event : TEvent ) ; virtual ;
  128.       procedure InitMenuBar ; virtual ;
  129.       procedure InitStatusLine ; virtual ;
  130.       procedure DialogEinm ;
  131.       procedure DialogRatenSp ;
  132.     end ;
  133.  
  134.  
  135.  
  136.     { Globale Variablen: }
  137.  
  138. VAR ausgabe : str250 ; { Ausgabe Ergebnisse mit MsgBox }
  139.     Einm : TEinm ;
  140.     EinmFl : PEinmal ;  { Finanzmathem. Library }
  141.     RatenSp : TRaten ; { Eingabewerte Ratensparen }
  142.     RatenSpFl : PRaten ; { Finanzmathem. Object }
  143.  
  144.  
  145. function periodenWert ( eingabe : Word ) : integer ;
  146.  
  147.   var ret : integer ;
  148.              { bei Eingabe der Periode mit TV wird ein
  149.                 Wert von 0-3 zurückgegeben
  150.                 diese Funktion macht daraus einen Rechenwert }
  151.   begin
  152.   ret := 12 ;
  153.   case eingabe of
  154.    0 : ret := 1 ;
  155.    1 : ret := 3 ;
  156.    2 : ret := 6 ;
  157.    3 : ret := 12 ;
  158.   end;
  159.  
  160.   periodenWert := ret ;
  161.  
  162.  end;
  163.  
  164.  
  165. constructor TRealValidator.Init ( AValidChars : TCharSet ) ;
  166.  
  167.     begin
  168.     inherited Init ( AValidChars );
  169.     end;
  170.  
  171.  
  172. function TRealValidator.IsValidInput ( var S : String ;
  173.              NoAutoFill : boolean ) : boolean ;
  174.  
  175.      var ok, komma : boolean ;
  176.          l, x : integer ;
  177.  
  178.      begin
  179.      ok := inherited IsValidInput ( S, NoAutoFill );
  180.      l := length ( S );
  181.      komma := false ;
  182.  
  183.      if  ok  and ( l > 0 ) then begin
  184.        for x := 1 to l do begin
  185.          if ( S[x] = ',' ) then S[x] := '.' ;
  186.          case S[x] of
  187.           '-' : if ( x <> 1 ) then ok := false ;
  188.                 { minus nur an erster Stelle }
  189.           '.' : if komma then ok := false
  190.                  else komma := true ;
  191.                  { nur 1 Komma je ZAHL }
  192.          '0'..'9':    { das ist ok }
  193.           else
  194.                  ok := false ;
  195.          end;
  196.          if not ok then break ;
  197.        end;
  198.     end;
  199.  
  200.     if not ok then write ( #7 );
  201.  
  202.     IsValidInput := ok ;
  203.  
  204.     end;
  205.  
  206.  
  207.  
  208. constructor TMyApp.init ;
  209.  
  210.   begin
  211.   inherited Init ;
  212.   EinmWindow := nil ;
  213.   RatenSpWindow := nil ;
  214.   end;
  215.  
  216.  
  217. procedure TMyApp.DialogEinm ;
  218.  
  219.  begin
  220.  if EinmFl = nil then
  221.    EinmFl := New ( PEinmal, Init );
  222.  
  223.  if Message ( Desktop, evBroadcast, cmEinmWinDa, nil ) = nil then begin
  224.    EinmWindow := New ( PEinmWindow, Init );
  225.    InsertWindow ( EinmWindow );
  226.    EinmWindow^.SetData ( Einm );
  227.   end
  228.   else
  229.    if PView ( EinmWindow ) <> Desktop^.TopView then
  230.      EinmWindow^.Select ;
  231.  
  232.    EinmWindow^.Show ;  { Darstellen }
  233.  
  234.  
  235.  end;
  236.  
  237.  
  238.  
  239. procedure TMyApp.DialogRatenSp ;
  240.  
  241.  begin
  242.  
  243.  if RatenSpFl = nil then
  244.    RatenSpFl := New ( PRaten, Init );
  245.  
  246.  if Message ( Desktop, evBroadcast, cmRatenSpWinDa, nil ) = nil then begin
  247.    RatenSpWindow := New ( PRatenWindow, Init );
  248.    InsertWindow ( RatenSpWindow );
  249.    RatenSpWindow^.SetData ( RatenSp );
  250.   end
  251.   else
  252.    if PView ( RatenSpWindow ) <> Desktop^.TopView then
  253.      RatenSpWindow^.Select ;
  254.  
  255.    RatenSpWindow^.Show ;  { Darstellen }
  256.  
  257.  
  258.  end;
  259.  
  260.  
  261. procedure TMyApp.InitStatusLine ;
  262.  
  263. var R : TRect ;
  264.  
  265. begin
  266. GetExtent ( R );
  267. R.A.Y := R.B.Y - 1 ;
  268. New (StatusLine, Init ( R,
  269.    NewStatusDef ( 0, $EFFF,    { der "normale" Bereich ohne Dialoge }
  270.      NewStatusKey ( '~F10~ Menü', kbF10, cmMenu ,
  271.      NewStatusKey ( '~Alt+X~ Ende', kbAltX, cmQuit,
  272.      nil )),
  273.    NewStatusDef ( $F000, $FFFF ,   { Bereich der Eingabemasken
  274.                               bei Dialogen über HelpCtx definiert }
  275.      NewStatusKey ( '~F2~ Bildsch.', kbF2, cmBildsch ,
  276.      NewStatusKey ( '~F3~ Drucker' , kbF3, cmDrucker ,
  277.      NewStatusKey ( '', kbF1, hcHilfen,
  278.      nil ))),
  279.    nil )))) ;
  280.  
  281. end ;
  282.  
  283.  
  284. procedure TMyApp.InitMenuBar  ;
  285.  
  286.   var R : TRect ;
  287.  
  288.   begin
  289.    getExtent (R );
  290.    R.B.Y := R.A.Y + 1 ;
  291.    MenuBar := New ( PMenuBar, Init ( R, NewMenu (
  292.      NewSubMenu ( '~S~parvorgänge', hcNoContext, NewMenu (
  293.        NewItem ( '~E~inmalbetrag', '', kbNoKey, cmEinmal, hcEinmal ,
  294.        NewItem ( '~R~atensparen', '', kbNoKey, cmRatenSp, hcRatenSp,
  295.        NewItem ( 'S~o~ndersparen', '', kbNoKey, cmSonderSp, hcSonderSp,
  296.        NewItem ( '~W~ertpapiere', '' , kbNoKey, cmWertp, hcWertp ,
  297.        NewLine (
  298.        NewItem ( '~E~nde ' , 'Alt-X', kbAltX, cmQuit, hcNoContext ,
  299.        nil ))))))),
  300.      NewSubMenu ( '~K~redite', hcNoContext, NewMenu (
  301.        NewItem ( '~D~arlehen', '', kbNoKey, cmDarl, hcDarl ,
  302.        NewItem ( '~T~ilgungsplan', '', kbNoKey, cmTilg, hcTilg,
  303.        NewItem ( '~R~atenkredit', '', kbNoKey, cmRatenKr, hcRatenKr,
  304.        nil )))) ,
  305.      nil )))
  306.       )) ;
  307.  
  308.    end ;
  309.  
  310. procedure TMyApp.NochNicht ;
  311.  
  312.    begin
  313.    MessageBox (  MsgNo , nil,
  314.                 mfInformation or mfOKButton );
  315.    end;
  316.  
  317. procedure TMyApp.HandleEvent ( var  Event : TEvent );
  318.  
  319.   begin
  320.    inherited HandleEvent ( Event );
  321.  
  322.    if Event.What = evCommand then
  323.    case Event.Command of
  324.     cm