home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / mathfunc.dem < prev    next >
Encoding:
Text File  |  1987-02-03  |  3.5 KB  |  132 lines
  1. (* Test und Demonstration der math. Funktions-Bibliothek:                   *)
  2.  
  3. PROGRAM mathfunc_test (INPUT, OUTPUT);
  4.  
  5. VAR wahl, taste: CHAR;
  6.  
  7. (*$I MATHFUNC.PAS *)                       (* INCLUDE: Bibliothek einlesen. *)
  8.  
  9. (****************************************************************************)
  10.  
  11. PROCEDURE loesche_bildschirm;       (* ev. an Ihre Pascalversion anpassen ! *)
  12.  
  13. BEGIN
  14.   ClrScr;
  15. END;
  16.  
  17. (****************************************************************************)
  18.  
  19. PROCEDURE zeige_menu;
  20.  
  21. BEGIN
  22.   loesche_bildschirm;
  23.   WriteLn('< Programm beenden durch Eingabe von "/" >'); WriteLn;
  24.   WriteLn('0.)  ggT          A.)  ld           K.)  artanh');
  25.   WriteLn('1.)  kgV          B.)  logarithmus  L.)  arcoth');
  26.   WriteLn('2.)  altgrad      C.)  e_hoch       M.)  sin   ');
  27.   WriteLn('3.)  radiant      D.)  x_hoch_y     N.)  cos   ');
  28.   WriteLn('4.)  fakultaet    E.)  sinh         O.)  tan   ');
  29.   WriteLn('5.)  kehrwert     F.)  cosh         P.)  cot   ');
  30.   WriteLn('6.)  sqr          G.)  tanh         Q.)  arcsin');
  31.   WriteLn('7.)  sqrt         H.)  coth         R.)  arccos');
  32.   WriteLn('8.)  ln           I.)  arsinh       S.)  arctan');
  33.   WriteLn('9.)  lg           J.)  arcosh       T.)  arccot');
  34.   WriteLn;
  35. END;
  36.  
  37. (****************************************************************************)
  38.  
  39. PROCEDURE berechnen;
  40.  
  41. VAR n1, n2: INTEGER;
  42.     x1, x2: REAL;
  43.  
  44.  
  45.   PROCEDURE write_funktionsergebnis;
  46.  
  47.   BEGIN
  48.     CASE wahl OF
  49.       '0': n1 := ggT(n1, n2);
  50.       '1': n1 := kgV(n1, n2);
  51.       '2': x1 := altgrad(x1);
  52.       '3': x1 := radiant(x1);
  53.       '4': x1 := fakultaet(n1);
  54.       '5': x1 := kehrwert(x1);
  55.       '6': x1 := sqr(x1);
  56.       '7': x1 := sqrt(x1);
  57.       '8': x1 := ln(x1);
  58.       '9': x1 := lg(x1);
  59.       'A': x1 := ld(x1);
  60.       'B': x1 := logarithmus(x1, x2);
  61.       'C': x1 := exp(x1);
  62.       'D': x1 := x_hoch_y(x1, x2);
  63.       'E': x1 := sinh(x1);
  64.       'F': x1 := cosh(x1);
  65.       'G': x1 := tanh(x1);
  66.       'H': x1 := coth(x1);
  67.       'I': x1 := arsinh(x1);
  68.       'J': x1 := arcosh(x1);
  69.       'K': x1 := artanh(x1);
  70.       'L': x1 := arcoth(x1);
  71.       'M': x1 := sin(x1);
  72.       'N': x1 := cos(x1);
  73.       'O': x1 := tan(x1);
  74.       'P': x1 := cot(x1);
  75.       'Q': x1 := arcsin(x1);
  76.       'R': x1 := arccos(x1);
  77.       'S': x1 := arctan(x1);
  78.       'T': x1 := arccot(x1);
  79.     END;
  80.     IF wahl IN ['0','1'] THEN
  81.       WriteLn(n1)
  82.     ELSE
  83.       WriteLn(x1:0:9);
  84.   END; (* write_funktionsergebnis *)
  85.  
  86. BEGIN (* berechnen *)
  87.   WriteLn; WriteLn; WriteLn;
  88.   Write('Argument');
  89.   IF wahl IN ['0','1','B','D'] THEN
  90.     BEGIN
  91.       Write(' 1 :  ');
  92.       IF wahl IN ['0','1'] THEN
  93.         ReadLn(n1)
  94.       ELSE
  95.         ReadLn(x1);
  96.       Write('Argument 2 :  ');
  97.       IF wahl IN ['0','1'] THEN
  98.         ReadLn(n2)
  99.       ELSE
  100.         ReadLn(x2);
  101.     END
  102.   ELSE
  103.     BEGIN
  104.       Write(' :  ');
  105.       IF wahl = '4' THEN
  106.         ReadLn(n1)
  107.       ELSE
  108.         ReadLn(x1);
  109.     END;
  110.   WriteLn;
  111.   Write('Funktionsergebnis =  ');
  112.   write_funktionsergebnis;
  113.   WriteLn; Write(' weiter -> RETURN druecken...');
  114.   ReadLn(taste);
  115. END;
  116.  
  117. (****************************************************************************)
  118.  
  119. BEGIN (* mathfunc_test *)
  120.   REPEAT
  121.     zeige_menu;
  122.     Write('Funktionskennzeichen eingeben >>>  ');
  123.     REPEAT
  124.       ReadLn(wahl);
  125.       IF wahl IN ['a'..'z'] THEN
  126.         wahl := Chr(Ord(wahl)-Ord('a')+Ord('A'));
  127.     UNTIL wahl IN ['0'..'9','A'..'T','/'];
  128.     IF wahl <> '/' THEN
  129.       berechnen;
  130.   UNTIL wahl = '/';
  131. END.
  132.