// Diese Routine wandelt Zahlen bis 999.999.999.999,99 in Worte um:
// 123456 => 'Einhundertdreiundzwanzigtausendvierhundertsechsundfünfzig'
// Zusätzlich kann man einstellen, ob die zwei Nachkommastellen (welche extra
// für Währungen eingeführt wurden)
auch in Worte umgewandelt werden sollen.
// mit dem Typ "tp" kann die Art der Ausgabe beeinflusst werden:
//

// Ohne: Die Nachkommastellen werden ignoriert:
// 12,89 => 'Zwölf'
// Komma: Die Nachkommastellen werden beachtet:
// 29,76 => 'Neunundzwanzig Komma Sechsundsiebzig'
// -8,14 => 'Minus Acht Komma Vierzehn'
// Waehrung: Es wird die Währungsbezeichnung mit angezeigt:
// 33,70 => 'Dreiunddreißig Euro Siebzig'
// 51,00 => 'Einundfünfzig Euro'
//
 0,20 => 'Null Euro Zwanzig'
// Zehntel: Die Zehntelwährungsbezeichnung wird ebenfalls angezeigt:
// 10,58 => 'Zehn Euro und Achtundfünfzig Cent'
//  0,03 => 'Drei Cent'
//
//
 Mittels der Variablen "gross" wird gesteuert, ob die Zahlworte mit
// einem kleinen oder einem großen Buchstaben beginnen.
// Die Währungseinheiten bei "whrng" und "zhntl" können logischerweise
// ausgetauscht werden, z.B.:
whrng = 'Dollar';


// Getestet mit D4 unter Win98

type 
  tp = (Ohne, Komma, Waehrung, Zehntel); 
 
const 
  whrng = 'Euro'; 
  zhntl = 'Cent'; 
 
function ztw(c: char): string; 
begin 
  case c of 
    '1': result := 'ein'; 
    '2': result := 'zwei'; 
    '3': result := 'drei'; 
    '4': result := 'vier'; 
    '5': result := 'fünf'; 
    '6': result := 'sechs'; 
    '7': result := 'sieben'; 
    '8': result := 'acht'; 
    '9': result := 'neun'; 
  else result := ''; 
  end; 
end; 
 
function zehner(s, vs, edg: string): string; 
var 
  z, e: char; 
const 
  zhn = 'zehn'; 
  u = 'und'; 
  zg = 'zig'; 
  zw = 'zwan' + zg; 
  dr = 'dreißig'; 
begin 
  z := s[1]; e := s[2]; 
  if e <> '1' then edg := ''; 
  case z of 
    '6': case e of 
        '0': result := 'sech' + zg; 
      else result := ztw(e) + u + 'sech' + zg; 
      end; 
    '7': case e of 
        '0': result := 'sieb' + zg; 
      else result := ztw(e) + u + 'sieb' + zg; 
      end; 
    '0': case e of 
        '0': result := ''; 
      else result := vs + ztw(e) + edg; 
      end; 
    '1': case e of 
        '0': result := zhn; 
        '1': result := 'elf'; 
        '2': result := 'zwölf'; 
        '3'..'5', '8', '9': result := ztw(e) + zhn; 
        '6': result := 'sech' + zhn; 
        '7': result := 'sieb' + zhn; 
      end; 
    '2': case e of 
        '0': result := zw; 
        '1'..'9': result := ztw(e) + u + zw; 
      end; 
    '3': case e of 
        '0': result := dr; 
        '1'..'9': result := ztw(e) + u + dr; 
      end; 
  else begin 
      if e > '0' then result := ztw(e) + u else result := ''; 
      result := result + ztw(z) + zg; 
    end; 
  end; 
end; 
 
function hunderter(s, vs, edg: string): string; 
var 
  h: char; 
  zw: string; 
begin 
  h := s[1]; zw := copy(s, 2, 2); 
  result := ztw(h); 
  if result <> '' then result := result + 'hundert'; 
  result := result + zehner(zw, vs, edg); 
end; 
 
function gruppe(s, vs, bw, e, m, name: string): string; 
var a: string; 
begin 
  if s = '000' then result := '' else begin 
    if copy(s, 2, 2) = '01' then a := e else a := m; 
    result := hunderter(s, vs, bw) + name + a; 
  end; 
end; 
 
function zahlwort(s: string; art: tp;gross:boolean): string; 
var z: double; 
  v, h, minus, vs, c, geld, sz: string; 
begin 
  try 
    z := strtofloat(stringreplace(trim(s), '.', '', [rfreplaceall])); 
    if z < 0 then minus := 'Minus ' else minus := ''; 
    z := abs(z); 
    if z <= 999999999999.99 then begin 
      if z > 99 then vs := 'und' else vs := ''; 
      v := inttostr(trunc(z)); 
      if v = '0' then result := 'null' else result := ''; 
      while length(v) < 12 do v := '0' + v; 
      if art in [waehrung, zehntel] 
        then begin 
        c := ''; 
        geld := #32 + whrng + #32; 
      end else begin 
        c := 's'; 
        geld := ''; 
      end; 
      result := result + gruppe(copy(v, 1, 3), '', 'e', 'e', 'en', 'milliard'); 
      result := result + gruppe(copy(v, 4, 3), '', 'e', '', 'en', 'million'); 
      result := result + gruppe(copy(v, 7, 3), '', '', '', '', 'tausend'); 
      result := result + gruppe(copy(v, 10, 3), vs, c, '', '', ''); 
      if (art <> ohne) then begin 
        h := copy(floattostrf(frac(z), fffixed, 15, 2), 3, 2); 
        if h = '00' then result := result + geld 
        else begin 
          if art = komma then begin 
            result := result + ' Komma '; 
            c := 's'; 
            if h[1] = '0' then result := result + 'null'; 
            if h[2] = '0' then h := '0' + h[1]; 
          end else begin 
            result := result + geld; 
            if art = zehntel then begin 
              if z < 1 then result := '' else 
                result := result + 'und '; 
              c := ''; 
            end else 
              c := 's'; 
          end; 
          sz := zehner(h, '', c); 
          if gross then sz[1] := upcase(sz[1]); 
          result := result + sz; 
          if art = zehntel then result := result + #32 + zhntl; 
        end; 
      end; 
      if gross then result[1] := upcase(result[1]); 
      result := minus + result; 
    end else result := 'Zahl zu groß'; 
  except 
    result := ''; 
  end; 
end; 
 
 
// Beispielaufruf 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 
begin 
  if key = #13 then begin 
    label1.caption := zahlwort(edit1.text, zehntel, true); 
    key := #0; 
  end; 
end;



Zugriffe seit 6.9.2001 auf Delphi-Ecke