Will man beispielsweise einen Scheck bedrucken, so steht man vor der Problem einen Geldbetrag (z.b. 123,-) in Worten (also “Einhundertdreiundzwanzig”) angeben zu müssen. Der folgende Quellcode tut dies für Zahlen bis zu 100 Milliarden.
Die Idee dahinter ist die Ziffern der Zahl immer in Dreierblöcke zu zerlegen und dann diese Dreierblöcke als einzelne Gruppen zwischen 0 und 999 zu behandeln. Im Anschluss wird dann eine “Nachsilbe” (z.b. “tausend”) an den Block angefügt. So lassen sich auch sehr große Zahlen (die leider nur selten auf meinen Schecks stehen) leicht in Text umwandeln.
PROCEDURE GetAmountInWords
@1105400001(p_Amount@1105400000 : Integer)
r_Result : Text[1024];
VAR
l_TempAmount@1105400001 : Text[1024];
BEGIN
IF p_Amount = 0 THEN
EXIT('Null');
l_TempAmount := FORMAT(p_Amount);
r_Result := GetGroup(l_TempAmount,0);
IF STRLEN(l_TempAmount) >= 1 THEN
r_Result := GetGroup(l_TempAmount,1) + r_Result;
IF STRLEN(l_TempAmount) >= 1 THEN
r_Result := GetGroup(l_TempAmount,2) + r_Result;
IF STRLEN(l_TempAmount) >= 1 THEN
r_Result := GetGroup(l_TempAmount,3) + r_Result;
IF STRLEN(l_TempAmount) >=1 THEN
ERROR('Betrag wird nicht unterstÂtzt.');
r_Result := UPPERCASE(COPYSTR(r_Result,1,1)) +
COPYSTR(r_Result,2,STRLEN(r_Result));
END;
PROCEDURE GetGroup
@1105400003(VAR v_Text@1105400003 : Text[1024];
p_Group@1105400006 : Integer)
r_Result : Text[1024];
VAR
l_H@1105400000 : Text[250];
l_T@1105400001 : Text[250];
l_O@1105400002 : Text[250];
l_Value@1105400004 : Integer;
l_Group@1105400005 : Text[3];
BEGIN
FillGroup(v_Text);
l_Group := COPYSTR(v_Text,
STRLEN(v_Text)-2,STRLEN(v_Text));
EVALUATE(l_Value,COPYSTR(l_Group,1,1));
IF l_Value > 0 THEN
IF l_Value = 1 THEN
l_H := 'einhundert'
ELSE
l_H := GetDigit(l_Value) + 'hundert';
EVALUATE(l_Value,COPYSTR(l_Group,2,2));
IF (l_Value >= 10) AND (l_Value < 20) THEN
l_O := GetTenToTwenty(l_Value)
ELSE BEGIN
EVALUATE(l_Value,COPYSTR(l_Group,2,1));
IF l_Value > 1 THEN
l_T := GetTens(l_Value);
EVALUATE(l_Value,COPYSTR(l_Group,3,1));
IF l_Value > 0 THEN BEGIN
IF l_T = '' THEN
l_O := GetDigit(l_Value)
ELSE BEGIN
IF l_Value = 1 THEN
l_O := 'einund'
ELSE
l_O := GetDigit(l_Value) + 'und';
END;
END;
END;
RemoveGroup(v_Text);
r_Result := l_H + l_O + l_T;
IF p_Group = 1 THEN BEGIN
IF r_Result = 'eins' THEN
r_Result := 'eintausend'
ELSE
r_Result := r_Result + 'tausend';
END;
IF p_Group = 2 THEN BEGIN
IF r_Result = 'eins' THEN
r_Result := 'einemillion'
ELSE
r_Result := r_Result + 'millionen';
END;
IF p_Group = 3 THEN BEGIN
IF r_Result = 'eins' THEN
r_Result := 'einemilliarde'
ELSE
r_Result := r_Result + 'milliarden';
END;
END;
PROCEDURE GetDigit
@1105400004(p_Value@1105400000 : Integer) : Text[30];
BEGIN
CASE p_Value OF
0: EXIT('null');
1: EXIT('eins');
2: EXIT('zwei');
3: EXIT('drei');
4: EXIT('vier');
5: EXIT('fÂnf');
6: EXIT('sechs');
7: EXIT('sieben');
8: EXIT('acht');
9: EXIT('neun');
ELSE
ERROR('%1 ist kein Einer',p_Value);
END;
END;
PROCEDURE GetTenToTwenty
@1105400005(p_Value@1105400000 : Integer) : Text[30];
BEGIN
CASE p_Value OF
10: EXIT('zehn');
11: EXIT('elf');
12: EXIT('zwölf');
13: EXIT('dreizehn');
14: EXIT('vierzehn');
15: EXIT('fünfzehn');
16: EXIT('sechzehn');
17: EXIT('siebzehn');
18: EXIT('achtzehn');
19: EXIT('neunzehn');
ELSE
ERROR('%1 ist nicht zwischen 10 und 20',p_Value);
END;
END;
PROCEDURE GetTens
@1105400006(p_Value@1105400000 : Integer) : Text[30];
BEGIN
CASE p_Value OF
2: EXIT('zwanzig');
3: EXIT('dreizig');
4: EXIT('vierzig');
5: EXIT('fünfzig');
6: EXIT('sechzig');
7: EXIT('siebzig');
8: EXIT('achtzig');
9: EXIT('neunzig');
ELSE
ERROR('%1 ist keine Zehner',p_Value);
END;
END;
PROCEDURE FillGroup
@1105400007(VAR v_String@1105400000 : Text[30]);
BEGIN
WHILE STRLEN(v_String) < 3 DO
v_String := '0' + v_String;
END;
PROCEDURE RemoveGroup
@1105400000(VAR v_String@1105400000 : Text[1024]);
BEGIN
v_String := COPYSTR(v_String,1,STRLEN(v_String) - 3);
END;
