home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 01 / tricks / ausgabe.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-10-10  |  3.0 KB  |  83 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   AUSGABE.PAS                          *)
  3. (*         Unit zur Ausgabe von REAL-Zahlen im            *)
  4. (*               Floating-Point-Format                    *)
  5. (*         (c) 1988 by Manfred Grote & TOOLBOX            *)
  6. (* ------------------------------------------------------ *)
  7. UNIT Ausgabe;
  8.  
  9. INTERFACE
  10.  
  11. USES Crt, Printer;
  12.  
  13. TYPE TGeraet = (Drucker, Monitor);
  14.  
  15. PROCEDURE WriteReal(Geraet         : TGeraet;
  16.                     r              : REAL;
  17.                     Feld, Dezimalen: INTEGER);
  18. IMPLEMENTATION
  19.  
  20. PROCEDURE WriteReal(Geraet         : TGeraet;
  21.                     r              : REAL;
  22.                     Feld, Dezimalen: INTEGER);
  23.  
  24.  
  25. TYPE Lage                  = (links, zentriert, rechts);
  26.  
  27. VAR  s                     : STRING[30];
  28.      Punktpos,
  29.      Vorkommastellen,
  30.      Stellen,
  31.      Leerzeichen, i        : INTEGER;
  32.      Schreibposition       : Lage;
  33.  
  34. BEGIN
  35.   IF (Abs(r) < 1E6) AND (Abs(r) > 1E-5)
  36.                      OR (Abs(r) < 1E-37) THEN BEGIN
  37.     IF (Feld = Dezimalen + 1) THEN
  38.       Schreibposition := links;
  39.     IF (Feld = Dezimalen + 2) THEN
  40.       Schreibposition := zentriert;
  41.     IF (Feld > Dezimalen + 2) THEN
  42.       Schreibposition := rechts;
  43.     Str(r: 30: Dezimalen, s);
  44.     Punktpos := Pos('.', s);
  45.     i := Punktpos;                       { Ermittlung der  }
  46.     REPEAT                               { signifikanten   }
  47.       i := Pred(i);                      { Vorkommastellen }
  48.     UNTIL (s[i] = ' ');
  49.     Vorkommastellen := Punktpos - (i + 1);
  50.     Stellen := Vorkommastellen + Dezimalen + 1;
  51.     IF Stellen >Feld THEN BEGIN
  52.       Dezimalen := Dezimalen - (Stellen - Feld);
  53.       Str(r : 30: Dezimalen, s);
  54.       Punktpos := Pos('.', s);
  55.     END;
  56.     i := Punktpos + Dezimalen;
  57.     WHILE (i > Punktpos) AND (s[i] = '0') DO BEGIN                                { Nachkommastellen }
  58.       Dezimalen := Pred(Dezimalen);     { Ermittlung der   }
  59.       i := Pred(i);                     { signifikanten    }
  60.     END;                                { Nachkommastellen }
  61.  
  62.     Stellen := Vorkommastellen + Dezimalen + 1;
  63.     IF Schreibposition = links THEN     { Korrektur von    }
  64.       Feld := Dezimalen + 1;            { Feld bzw.        }
  65.     IF Schreibposition = zentriert THEN { Dezimalen nach   }
  66.       Feld := (Feld + Stellen) DIV 2;   { den Vorgaben     }
  67.   END;
  68.   IF Geraet = Monitor THEN
  69.     IF (Abs(r) >= 1E6) OR (Abs(r) <= 1E-5) THEN BEGIN
  70.       IF Abs(r) > 1E-37 THEN Write(r: Feld)
  71.       ELSE Write(0: Feld);
  72.     END ELSE Write(r: Feld: Dezimalen);
  73.     IF Geraet = Drucker THEN
  74.       IF (Abs(r) >= 1E6) OR (Abs(r) <= 1E-5) THEN BEGIN
  75.         IF Abs(r) > 1E-37 THEN Write(Lst, r: Feld)
  76.         ELSE Write(Lst, 0: Feld);
  77.       END ELSE Write(Lst, r: Feld: Dezimalen);
  78.   END;
  79.  
  80. END.
  81. (* ------------------------------------------------------ *)
  82. (*                  Ende von RAUSGABE.PAS                 *)
  83.