// 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;
![](zurueck.gif)
|