小写金额转换为大写

1. function MoneyToUpper(const NumBer: Double): string;
2. var StrNumber, AUpperNum, AMoneyUnit: string;
3.   UpperNum: array[0..9] of string;
4.   MoneyUnit: array[1..16] of string;
5.   I: Integer;
6.   AZero: Boolean;
7.   N: Double;
8. begin
9.   UpperNum[1] := '壹';
10.   UpperNum[2] := '贰';
11.   UpperNum[3] := '叁';
12.   UpperNum[4] := '肆';
13.   UpperNum[5] := '伍';
14.   UpperNum[6] := '陆';
15.   UpperNum[7] := '柒';
16.   UpperNum[8] := '捌';
17.   UpperNum[9] := '玖';
19.   MoneyUnit[1] := '万';
20.   MoneyUnit[2] := '仟';
21.   MoneyUnit[3] := '佰';
22.   MoneyUnit[4] := '拾';
23.   MoneyUnit[5] := '亿';
24.   MoneyUnit[6] := '仟';
25.   MoneyUnit[7] := '佰';
26.   MoneyUnit[8] := '拾';
27.   MoneyUnit[9] := '万';
28.   MoneyUnit[10] := '仟';
29.   MoneyUnit[11] := '佰';
30.   MoneyUnit[12] := '拾';
31.   MoneyUnit[13] := '元';
32.   MoneyUnit[14] := '.';
33.   MoneyUnit[15] := '角';
34.   MoneyUnit[16] := '分';
36.   AZero := False;
37.   AUpperNum := '';
38.   AMoneyUnit := '';
39.   result := '';
40.   if NumBer < 0 then
41.   begin
42.     result := '负';
43.     N := -NumBer;
44.   end
45.   else
46.     N := NumBer;
47.   Str(N: 16: 2, StrNumber);
49.   for I := 1 to 16 do
50.   begin
51.     if StrNumber[I] <> '   ' then
52.     begin
53.       AMoneyUnit := MoneyUnit[I];
54.       if StrNumber[I] = '0' then
55.       begin
56.         if AZero and (copy(result, Length(result) - 1, 2) = '零') then
57.           result := copy(result, 1, Length(result) - 2);
58.         case I of
59.           1..4, 6..8, 10..12: begin //   万，仟，佰，拾
60.               AUpperNum := '零';
61.               AMoneyUnit := '';
62.             end;
63.           5, 9, 13: begin //   亿，万，元
64.               if StrToFloat(StrNumber) < 1 then AMoneyUnit := '';
65.               AUpperNum := '';
66.             end;
67.           15: begin //   角
68.               if StrToFloat(StrNumber) < 1 then AUpperNum := ''
69.               else AUpperNum := '零';
70.               AMoneyUnit := '';
71.             end;
72.           16: begin //   分
73.               AUpperNum := '';
74.               AMoneyUnit := '';
75.             end;
76.         end;
77.         AZero := True;
78.       end
79.       else
80.       begin
81.         if StrNumber[I] = '.' then
82.         begin
83.           AUpperNum := '';
84.           AMoneyUnit := '';
85.         end
86.         else
87.         begin
88.           AZero := False;
89.           AUpperNum := UpperNum[StrToInt(StrNumber[I])];
90.         end
91.       end;
92.       result := result + (AUpperNum + AMoneyUnit)
93.     end;
94.   end;
95.   result := result + '整';
96. end;