home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / runde.pas < prev    next >
Pascal/Delphi Source File  |  1987-04-15  |  3KB  |  51 lines
  1. (*-------------------------------------------------------------------*)
  2. (*                            RUNDE.PAS                              *)
  3. (*       eine Loesung zum korrekten kaufmaennischen Runden           *)
  4. (*                                                                   *)
  5. (* Aufruf:   ergebnis := Runden(Ausdruck, Nachkommastellen);         *)
  6. (*   Bsp.: x := Runde(y,2); y := Runde(preis*rabatt,2) usw.          *)
  7. (*-------------------------------------------------------------------*)
  8.  
  9. FUNCTION Runde (wert: REAL; n: INTEGER): REAL;
  10.  
  11. VAR tmpstr            : STRING [80];
  12.     ziffer            : CHAR;
  13.     x                 : INTEGER;
  14.     ueberlauf, negativ: BOOLEAN;
  15.  
  16. BEGIN
  17.   negativ := wert < 0;                (* Vorzeichen merken           *)
  18.   wert := abs(wert);
  19.   Str (wert:0:24, tmpstr);            (* REAL -> Zeichenkette. Ergibt
  20.                                          mit ':0:24' immer soetwas:
  21.                                          ###.#########...            *)
  22.   x := Succ(Pos('.', tmpstr)+n);      (* zu rundente Stelle suchen   *)
  23.   ziffer := tmpstr[x];
  24.   delete(tmpstr, x, 80);              (* Rest abschneiden...         *)
  25.   IF ziffer >= '5' THEN               (* Das Ganze nur, wenn unbe-   *)
  26.   BEGIN                               (* dingt noetig, sonst         *)
  27.     REPEAT                            (* genuegt abschneiden.        *)
  28.       x := Pred(x);                   (* vorhergehende Stelle nehmen.*)
  29.       ziffer := tmpstr[x];            (* wg. Geschwindigkeit !       *)
  30.       IF ziffer IN ['0'..'9'] THEN    (* Dezimalpunkt ? nein...      *)
  31.       BEGIN
  32.         ziffer := Succ(ziffer);       (* Eins addieren...            *)
  33.         ueberlauf := ziffer > '9';
  34.         IF ueberlauf THEN             (* Ueberlaufkorrektur ?        *)
  35.           ziffer := '0';
  36.         tmpstr[x] := ziffer;
  37.       END;
  38.     UNTIL (x = 0) OR NOT ueberlauf;   (* bis keine Stellen mehr vor-
  39.                                          handen oder keine Korrektur
  40.                                          mehr notwendig ist          *)
  41.     IF (x) = 0 THEN                   (* auf zur naechsten Zehner-   *)
  42.       Insert('1', tmpstr, 1);         (* potenz, wenn notwendig!     *)
  43.   END;
  44.   Val (tmpstr, wert, x);              (* Zeichenkette -> REAL        *)
  45.   IF negativ THEN                     (* altes Vorzeichen nicht verg.*)
  46.     wert := -1*wert;
  47.   Runde := wert;
  48. END;
  49.  
  50. (*-------------------------------------------------------------------*)
  51.