home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / tricks / x_hoch_y.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-08-06  |  1.9 KB  |  54 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    X_HOCH_Y.PAS                        *)
  3. (*           einfaches Berechnen von Potenzen             *)
  4. (*           (c) 1990 Michael Lauer & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6.                        { txMath }
  7.   FUNCTION x_hoch_y(    x      : REAL;
  8.                         y      : DOUBLE;
  9.                     VAR ErrMsg : StringZeiger) : EXTENDED;
  10.  
  11.   CONST
  12.     overflow    : STRING = 'Überlauf bei Ausrechnung, ' +
  13.                            'Werte sind zu klein/groß';
  14.     exp_is_zero : STRING = 'Die Basis Null darf keine ' +
  15.                            'Zahl kleiner/gleich Null '  +
  16.                            'als Exponenten haben';
  17.     minus_base  : STRING = 'Eine negative Basis darf '  +
  18.                            'keine Bruchzahl als '       +
  19.                            'Exponenten haben';
  20.   VAR
  21.     changed_sign : BOOLEAN;
  22.     help         : DOUBLE;
  23.     d_result     : EXTENDED;
  24.   BEGIN
  25.     ErrMsg       := NIL;
  26.     changed_sign := x < 0;
  27.     IF changed_sign THEN x := -x;
  28.     IF x = 0 THEN BEGIN
  29.       IF y <= 0 THEN
  30.         ErrMsg := @exp_is_zero
  31.       ELSE
  32.         x_hoch_y := 0;
  33.              { Sonderfall: bei X = 0 und Y > 0 ist X^Y = 0 }
  34.       Exit;
  35.     END;
  36.     d_result := y * Ln(x);
  37.     IF (d_result < -2838) OR (d_result > 2838) THEN BEGIN
  38.       ErrMsg := @overflow;
  39.       Exit;
  40.     END;
  41.     IF changed_sign AND (Abs(Frac(y)) < 1E-10) THEN BEGIN
  42.       y := Trunc(y);
  43.       IF Odd(Round(y)) THEN
  44.         x_hoch_y := -(Exp(d_result))
  45.       ELSE
  46.         x_hoch_y := Exp(d_result);
  47.     END ELSE
  48.       IF NOT changed_sign THEN
  49.         x_hoch_y := Exp(d_result)
  50.       ELSE
  51.         ErrMsg := @minus_base;
  52.   END;
  53. (* ------------------------------------------------------ *)
  54. (*                Ende von X_HOCH_Y.PAS                   *)