home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / inworten.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-06  |  4.1 KB  |  122 lines
  1. (* ------------------------------------------------------ *)
  2. (*                  INWORTEN.PAS                          *)
  3. (*          (c) 1990  Volker Markl & TOOLBOX              *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM ZahlinWorten;
  6.  
  7. TYPE
  8.   Geschlechter = (maskulinum, femininum, neutrum);
  9.  
  10. VAR
  11.   s : LONGINT;
  12.  
  13.   FUNCTION InWorten(z          : LONGINT;
  14.                     geschlecht : Geschlechter) : STRING;
  15.   CONST
  16.     ein  : ARRAY [0..9] OF STRING [6] =
  17.              ('',      'ein',   'zwei',
  18.               'drei',  'vier',  'fünf',
  19.               'sechs', 'sieben','acht',
  20.               'neun');
  21.  
  22.     zehn : ARRAY[0..9] OF STRING[8]=
  23.              ('',        'zehn', 'zwanzig',
  24.               'dreißig', 'vierzig',
  25.               'fünfzig', 'sechzig',
  26.               'siebzig', 'achtzig',
  27.               'neunzig');
  28.  
  29.   VAR
  30.     z2, z3                   : LONGINT;
  31.     hunderter, zehner, einer : BYTE;
  32.     ergebnis                 : STRING;
  33.     pot, i                   : BYTE;
  34.   BEGIN
  35.     IF z <> 0 THEN ergebnis := ''
  36.               ELSE ergebnis := 'Null';
  37.     REPEAT      (* Zahl in dreistellige Teilzahl zerlegen *)
  38.       pot := 0; (* und Potenz zu 10^3 ermitteln           *)
  39.       z2  := z;
  40.       WHILE z2 > 999 DO BEGIN
  41.         z2 := z2 DIV 1000;
  42.         Inc(pot);
  43.       END;
  44.       z3 := z2;
  45.       i  := 0;
  46.       WHILE i < pot DO BEGIN
  47.         Inc(i);
  48.         z3 := z3 * 1000;
  49.       END;
  50.       z := z - z3;
  51.       hunderter := z2 DIV 100;
  52.       zehner    := (z2 - hunderter * 100) DIV 10;
  53.       einer     := z2 - hunderter * 100 - zehner * 10;
  54.       IF hunderter <> 0 THEN
  55.         ergebnis := ergebnis + ein[hunderter] + 'hundert';
  56.       CASE zehner OF
  57.         2..9 : IF einer = 0 THEN
  58.                  ergebnis := ergebnis + zehn[zehner]
  59.                ELSE
  60.                  ergebnis := ergebnis + ein[einer] +
  61.                              'und' + zehn[zehner];
  62.         1    : CASE einer OF
  63.                  1 : ergebnis := ergebnis + 'elf';
  64.                  2 : ergebnis := ergebnis + 'zwölf';
  65.                  6 : ergebnis := ergebnis + 'sechzehn';
  66.                  7 : ergebnis := ergebnis + 'siebzehn';
  67.  
  68.                  0, 3, 4, 5, 8, 9:
  69.                      ergebnis := ergebnis + ein[einer] +
  70.                                  zehn[zehner];
  71.                END;
  72.         0    : IF einer <> 0 THEN
  73.                  ergebnis := ergebnis + ein[einer];
  74.       END;
  75.       IF (z2 MOD 100 = 1) AND (pot <> 1) AND (pot <> 0) THEN
  76.         ergebnis := ergebnis + 'e';
  77.       IF (z2 MOD 100 = 1) AND (pot = 0) THEN
  78.         CASE geschlecht OF
  79.           maskulinum : ergebnis := ergebnis + 'en';
  80.           femininum  : ergebnis := ergebnis + 'e';
  81.           neutrum    : ergebnis := ergebnis + '';
  82.         END;
  83.         CASE pot OF      (* Je nach 10^3 Potenz anhängen: *)
  84.           0 : ;
  85.           1 : ergebnis := ergebnis + 'tausend';
  86.           2 : ergebnis := ergebnis + ' Million';
  87.           3 : ergebnis := ergebnis + ' Milliarde';
  88.         END;
  89.         IF z2 <> 1 THEN BEGIN
  90.                (* Mehrzahlbildung (Millionen, Milliarden) *)
  91.           IF (pot MOD 2 = 1) AND (pot <> 1) THEN
  92.             ergebnis := ergebnis + 'n '
  93.           ELSE IF (pot MOD 2 = 0) AND (pot <> 0) THEN
  94.             ergebnis := ergebnis + 'en '
  95.         END ELSE IF (pot <> 0) AND (pot <> 1) THEN
  96.           ergebnis := ergebnis + ' ';
  97.         IF (z < 100) AND (z > 0) THEN
  98.           ergebnis := ergebnis + 'und';
  99.         IF (z < 100) AND (z > 0) AND (pot <> 1) THEN
  100.           ergebnis := ergebnis + ' ';
  101.     UNTIL z = 0;
  102.  
  103. (*
  104.     FOR i := 1 TO Length(ergebnis) DO
  105.       IF (ergebnis[i] = ' ') AND (i < Length(ergebnis)) THEN
  106.         ergebnis[i+1] := UpCase(ergebnis[i+1]);
  107.       ergebnis[1] := UpCase(ergebnis[1]);
  108. *)
  109.     inworten := ergebnis;
  110.   END;
  111.  
  112. BEGIN
  113.   REPEAT
  114.     Write('Geben Sie eine Zahl (bis 2147483647) ein,',
  115.           ' negativ beendet: ');
  116.     ReadLn(s);
  117.     WriteLn(Inworten(Abs(s), femininum));
  118.   UNTIL s < 0;
  119. END.
  120. (* ------------------------------------------------------ *)
  121. (*               Ende von INWORTEN.PAS                    *)
  122.