如何将阿拉伯数字（如：5643）转换为中文大写（如：伍扦陆佰肆拾叁圆整） (100分)

注：由于阿拉伯数字是随机产生的，即无论产生的阿拉伯数字是什么（如：4732或758455）均要
能正确的转换为中文大写。中文数字的最高单位级为“百万”。请大家帮帮忙。

今天心情不错，写段代码先，少待。

http://www.playicq.com/dispdoc.asp?id=710

function conup(n: Integer): string;
const
shz: WideString = '壹贰叁肆伍陆柒捌玖';
wei: WideString = '佰拾万仟佰拾';
var
s: String;
i, m: Integer;
f: Boolean;
begin
s := IntToStr;
f := false;
for i := 1 to Length(s) do
begin
m := Ord(s) - 48;
if m <> 0 then
begin
if f then
begin
result := result + '零';
f := false;
end;
result := result + shz[m] + wei[7 - Length(s) + i];
end
else
begin
if Length(s) - i = 4 then
result := result + '万';
f := true;
end;
end;
result := result + '圆整';
end;

很容易扩展：
function conup(n: Int64): string;
const
shz: WideString = '壹贰叁肆伍陆柒捌玖';
wei: WideString = '仟佰拾亿仟佰拾万仟佰拾圆';
var
s: String;
i, m: Integer;
f: Boolean;
begin
s := IntToStr;
f := false;
for i := 1 to Length(s) do
begin
m := Ord(s) - 48;
if m <> 0 then
begin
if f then
begin
result := result + '零';
f := false;
end;
result := result + shz[m] + wei[Length(wei) - Length(s) + i];
end
else
begin
case Length(s) - i of
0: result := result + '圆';
4: result := result + '万';
8: result := result + '亿';
end;
f := true;
end;
end;
result := result + '整';
end;

to libin06
测试了你的函数，
100008－》壹拾万零捌圆整
习惯是拾万零捌圆整

Function TForm33.CurrToCharNum(f:string):String;
var
Fs,dx,d2,zs,xs,h,jg:string;
i,ws,w,j,lx:integer;
begin
f := Trim(f);
if copy(f,1,1)='-' then
begin
Delete(f,1,1);fs:='负';
end
else
fs:='';
dx:='零壹贰叁肆伍陆柒捌玖';
d2:='拾佰仟万亿';
i := AnsiPos('.',f);
//小数点位置
if i = 0 then
zs := f //整数
else
begin
zs:=copy(f,1,i - 1);
//整数部分
xs:=copy(f,i + 1,200);
end;
ws:= 0;
//l := 0;
for i := Length(zs) do
wnto 1 do
begin
ws := ws + 1;
h := '';
w:=strtoint(copy(zs, i, 1));
if (w=0) and (i=1) then
jg:='零';
If w > 0 then
Case ws of
2..5:h:=copy(d2,(ws-1)*2-1,2);
6..8:begin
h:=copy(d2,(ws-5)*2-1,2);
If AnsiPos('万',jg)=0 then
h:=h+'万';
end;
10..13:h := copy(d2,(ws-9)*2-1, 2);
end;
jg:=copy(dx,(w+1)*2-1,2) + h + jg;
If ws=9 then
jg := copy(jg,1,2) + '亿' + copy(jg,3,200);
end;
j:=AnsiPos('零零',jg);
While j > 0 do
begin
jg := copy(jg, 1, j - 1) + copy(jg, j + 2,200);
j := AnsiPos('零零',jg);
end;
If (Length(jg) > 1) And (copy(jg,length(jg)-1,2)='零') then
jg :=copy(jg,1,Length(jg)-2);
j := AnsiPos('零亿',jg);
If j > 0 then
jg := copy(jg,1, j - 1) + copy(jg, j + 2,200);
//转换小数部分
lx := Length(xs);
If lx > 0 then
begin
jg := jg + '元';
For i := 1 To lx do
begin
if i=1 then
begin
jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
jg := jg +'角';
end;
if i=2 then
begin
jg := jg + copy(dx, strtoint(copy(xs,i,1))*2 + 1, 2);
jg := jg +'分';
end;
end;
j :=AnsiPos('零角零分',jg);
if j>0 then
jg := copy(jg,1,j-1)+copy(jg,j+8,200)+'整';
j := AnsiPos('零角',jg);
i:=AnsiPos('零分',jg);
if (j>0) and (i>0) then
jg := copy(jg,1,j-1)+copy(jg,j+4,200)
else
begin
if (j>0)and(i=0) then
jg:= copy(jg,1,j+1)+copy(jg,j+4,200);
if i>0 then
jg := copy(jg,1,i-1);
end;
End
else
jg := jg + '元整';
result := fs+jg;
end;

function dec(m:Currency):string;
var
j1,i,j:Integer;
ds:String;
xx: array[1..9] of string;
begin
xx[1]:='壹';
xx[2]:='贰';
xx[3]:='叁';
xx[4]:='肆';
xx[5]:='伍';
xx[6]:='陆';
xx[7]:='柒';
xx[8]:='捌';
xx[9]:='玖';
j:=0;
j1:=0;
if m < 0 then
m:=-m;
i:=trunc(m/10000000);
ds:='〈币';
if i >0 then
begin
ds:=trim(ds)+xx+'仟';
m:=m-i*10000000;
j:=1;
j1:=0;
end;
i:=trunc(m/1000000);
m:=m-i*1000000;
if i > 0 then
begin
ds:=trim(ds)+xx+'佰';
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) then
j1:=1;
i:=trunc(m/100000);
m:=m-i*100000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'拾'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'拾';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/10000);
m:=m-i*10000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'万'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'万';
end;
j:=1;
j1:=0;
end
else
begin
if j=1 then
ds:=trim(ds)+'万';
if (j=1) and (m >0) and (j1=0) then
j1:=1;
end;
i:=trunc(m/1000);
m:=m-i*1000;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'仟'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'仟';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/100);
m:=m-i*100;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'佰'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'佰';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m/10);
m:=m-i*10;
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'拾'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'拾';
end;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
j1:=1;
i:=trunc(m);
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'元'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'元';
end;
j:=1;
j1:=0;
end
else
begin
if j=1 then
ds:=trim(ds)+'元';
if (j=1) and (m >0) and (j1=0) then
j1:=1;
end;
j1:=0;
m:=m*100-i*100;
//i:=round(m/10);
i:=trunc(m/10);
if i > 0 then
begin
if j1=0 then
ds:=trim(ds)+xx+'角'
else
begin
ds:=trim(ds)+'零';
ds:=trim(ds)+xx+'角';
end;
m:=m-i*10;
j:=1;
j1:=0;
end
else
if (j=1) and (m >0) and (j1=0) then
begin
ds:=trim(ds)+'零';
j1:=1;
end;
//i:=round(m);
i:=trunc(m);
if i > 0 then
begin
ds:=trim(ds)+xx+'分';
j:=1;
end;
if j=0 then
ds:=trim(ds)+'整';
ds:=trim(ds)+'〉';
result:=ds;
end;

我觉得这段代码不错
function FourNumToChnNum(Str:string;ChnNum:string;var Pre:boolean):string;
const
ChnNum2='零壹贰叁肆伍陆柒捌玖';
var
i,j,Len:integer;
begin

Result := '';
Len := Length(str) ;
for i:=1 to Len do
begin

j := Ord(str)-48;
if j=0 then

Pre := True
else
begin

if Pre then

Result := Result + '零';
Result := Result + Copy(ChnNum2,j*2+1,2) + Trim(Copy(ChnNum,(Len - i) * 2+1,2));
Pre := False;
end;

end;

end;

function StringToChnNum(str:string):string;
const
ChnNum1='圆万亿兆';
var
i,Len,Len1,Level,Start:integer;
s1,s:string;
Pre: Boolean;
begin

Result := '';
Len := Pos('.',str)-1;
Level := (Len + 3) div 4 ;
Len1 := Len mod 4 ;
if Len1=0 then

Len1 := 4;
Start := 1;
Pre := False;
for i := 1 to Level do
begin

s := Copy(str,Start,Len1);
s1 := FourNumToChnNum(s,' 拾佰仟',Pre);
// 注意有两个空格
if s1<>'' then

Result := Result + s1 + Copy(ChnNum1,(Level-i)*2+1,2);;
Start := Start + Len1;
Len1 := 4;
end;

s1 := FourNumToChnNum(Copy(str,Len+2,2),'分角',Pre);
if s1 = '' then

s1 := '整';
Result := Result + s1 ;
end;

function RealToChnNum(realnum:real;Width:integer):string;
var
s:string;
begin

Str(realnum:Width:2,s);
Result := StringToChnNum(Trim(s));
end;

借花献佛！
{***********************数字转换汉字函数A定义***********************}
function TMainForm.DecimalToChinese(number:Extended;cntype:integer):string;
{介绍：参数number为Extended类型
cntype=0:转换为人民币大写格式
cntype=1:转化为数字大写格式
例如：decimaltocn(45092034.541,0) :'肆仟伍佰零玖万贰仟零叁拾肆元伍角肆分
decimaltocn(45092034.541,1) :'肆仟伍佰零玖万贰仟零叁拾肆点伍肆壹
数值大小有限制，最大到百万亿 }
var
numstr:array[1..12] of string;//中文数位名
str1,str2,intstr,decstr:string;//整数部分,小数部分,大写整数部分,大写小数部分
num:array[1..10] of string;//各个数位段,即每四位为一段
n:array[1..10] of string;//各位数字
number1,number2,number3:string;//定义数字的三个数位段
pointpos:integer;//小数点位置
decpos:integer;
NumHead:string;//正负性
NumberName:string;//用于代替参数Number的字符串
NumLen:integer;//参数Number的串长度
begin
if (Cntype<>0) and (CnType<>1) then
begin
showmessage('参数错误：选择转换类型参数值错误！');
result:='';
exit;
end;
{初始化}
numstr[1] :='零';
numstr[2] :='壹';
numstr[3] :='贰';
numstr[4] :='叁';
numstr[5] :='肆';
numstr[6] :='伍';
numstr[7] :='陆';
numstr[8] :='柒';
numstr[9] :='捌';
numstr[10]:='玖';
numstr[11]:='拾';
str1:='';
str2:='';
intstr:='';
decstr:='';
if Number<0 then
//如果是负数，则在前面加‘负'
begin
NumHead:='负';
Number:=-Number;
end
else
NumHead:='';
NumberName:=Floattostr(Number);
NumLen:=Length(NumberName);
pointpos:=pos('.',NumberName);
//以下将得到整数部分Str1和小数部分Str2
if pointpos=0 then
//输入值为纯整数
begin
str1:=NumberName;
str2:=''
end
else
//输入值为浮点数
begin
if cntype=0 then
//如果转换为人民币大写，并且小数数位超过2位，则只保留2位
if (NumLen-pos('.',numberName))>2 then
NumberName:=trim(format('%'+inttostr(NumLen)+'.2f',[Number]));
str1:=copy(numberName,1,pos('.',numberName)-1);//取整数部分
str2:=copy(numberName,pos('.',numberName)+1,length(numberName)-pos('.',numberName));//取小数部分
if strtoint64(str2)=0 then
//如果小数部分为0，则取消小数部分的分析
str2:='';
end;
{*****分析转换整数部分*****}
{分析整数部分在100000000以上的}
if length(str1)>8 then
begin
//按每4位为一段拆分成三段，逐段分析
num[1]:=copy(str1,1,length(str1)-8);//取8位以上的那部分数段
num[2]:=copy(str1,length(str1)-7,4);//取千万到万的4位
num[3]:=copy(str1,length(str1)-3,4);//取千到个位的4位
number1:=DecimalToChinese(strtoint64(num[1]),1)+'亿';//通过函数嵌套调用，得到亿上的数段格式，即若干亿
if strtoint64(Num[2])=0 then
//如果千万到万4位为0
begin
if strtoint64(Num[3])=0 then
//并且末尾4位为0
Number2:=''//没有内容
else
begin
if strtoint64(Num[3])<1000 then
Number2:=''//如果第三段也是零XX百十个，则中间段的"零"去掉
else
Number2:=numstr[1];//读零
end;
end
else
begin
if strtoint64(num[2])>1000 then
//中间4位大于1000
Number2:=DecimalToChinese(strtoint64(num[2]),1)+'万'
else
Number2:=numStr[1]+DecimalToChinese(strtoint64(num[2]),1)+'万';//不足一千万，则读X亿零xx百、十、万
end;
if strtoint64(Num[3])=0 then
//末尾4位为0
Number3:=''
else
begin
if strtoint64(num[3])>1000 then
//末尾4位大于1000
Number3:=DecimalToChinese(strtoint64(num[3]),1)
else
Number3:=numstr[1]+DecimalToChinese(strtoint64(num[3]),1);//不足一千，则读X万零XX百、十
end;
intstr:=number1+number2+number3;
end;

{分析整数部分在10000~99999999之间的}
if (length(str1)>=5) and (length(str1)<=8) then
begin
num[1]:=copy(str1,1,length(str1)-4);//取得第一段（千万位到万位）
//为方便分析，若不足4位,用'0'补齐为4位
if length(num[1])=3 then
num[1]:='0'+num[1];
if length(num[1])=2 then
num[1]:='00'+num[1];
if length(num[1])=1 then
num[1]:='000'+num[1];
num[2]:=copy(str1,length(str1)-3,4);//取得第二段（千位到个位）
number1:=DecimalToChinese(strtoint64(num[1]),1)+'万';
if strtoint64(num[2])=0 then
number2:=''
else
begin
if strtoint64(num[2])>1000 then
//中间4位大于1000
Number2:=DecimalToChinese(strtoint64(num[2]),1)
else
Number2:=numStr[1]+DecimalToChinese(strtoint64(num[2]),1);
end;
intstr:=number1+number2;
end;
{分析整数部分不到10000的}
if length(str1)<5 then
begin
num[1]:=str1;
//不足4位,用'0'补齐
if length(num[1])=3 then
num[1]:='0'+num[1];
if length(num[1])=2 then
num[1]:='00'+num[1];
if length(num[1])=1 then
num[1]:='000'+num[1];
number1:='';//亿以上的为空
number2:='';//万以上的为空
//分析千位
if copy(num[1],1,1)='0' then
n[1]:=''
else
n[1]:=numstr[strtoint64(copy(num[1],1,1))+1]+'仟';
//分析百位
if copy(num[1],2,1)='0' then
begin
if copy(num[1],1,1)='0' then
n[2]:=''
else
n[2]:=numstr[1]
end
else
n[2]:=numstr[strtoint64(copy(num[1],2,1))+1]+'佰';
//分析十位
if copy(num[1],3,1)='0' then
begin
if copy(num[1],2,1)='0' then
n[3]:=''
else
n[3]:=numstr[1]
end
else
begin
if (copy(num[1],1,1)='0') and (copy(num[1],2,1)='0') and (copy(num[1],3,1)='1') then
//如果百位为0且十位为1则不读出壹字
n[3]:='拾'
else
n[3]:=numstr[strtoint64(copy(num[1],3,1))+1] +'拾';
end;

//分析个位
if copy(num[1],4,1)='0' then
n[4]:=''
else
n[4]:=numstr[strtoint64(copy(num[1],4,1))+1];
//
if copy(num[1],length(num[1])-2,3)='000' then
//当末尾有000时
begin
n[2]:='';
n[3]:='';
n[4]:=''
end;
if copy(num[1],length(num[1])-1,2)='00' then
//当末尾有00时
begin
n[3]:='';
n[4]:=''
end;
if copy(num[1],length(num[1]),1)='0' then
//当末尾有0时
n[4]:='';
//数段合并
number3:=n[1]+n[2]+n[3]+n[4];
//取得整数位值
intstr:=number1+number2+number3;
end;
{如果整数为零,转换为"零"}
if str1='0' then
intstr:=numstr[1];
{整数转换完毕}

{*****分析和转换小数部分*****}
if length(str2)>0 then
//如果小数数段不为空，则分析小数
begin
if cntype=0 then
{一.如果转换为人民币表达式}
begin
//不足2位，用零补足空位
if length(str2)=1 then
str2:=str2+'0';
if copy(str2,1,1)='0' then
//角为0
begin
if Intstr='零' then
n[1]:='' else
n[1]:='零';//如果元为0，则不读0角，否则读零若干分
end
else
n[1]:=numstr[strtoint64(copy(str2,1,1))+1]+'角';
if copy(str2,2,1)='0' then
n[2]:=''
else
n[2]:=numstr[strtoint64(copy(str2,2,1))+1]+'分';
decstr:=n[1]+n[2];
end
else
//二.如果转换为数字表达式
begin
decstr:='';
for decpos:=1 to length(str2) do
begin
decstr:=decstr+numstr[strtoint64(copy(str2,decpos,1))+1];
end;
end;
end;
{小数转换完毕}
{输出本函数的结果***********************}
if cntype=0 then
//将数字字串转换为人民币的大写格式
begin
if str2='' then
//如果为纯整数
result:=NumHead+intstr+'元整'
else
begin
if intstr='零' then
//如果整数为零，就只显示小数
result:=NumHead+decstr
else
result:=NumHead+intstr+'元'+decstr
end;
end;
if cntype=1 then
//将数字字串转换为普通大写格式
begin
if str2='' then
//如果为纯整数
result:=NumHead+intstr
else
result:=NumHead+intstr+'点'+decstr
end;
{转换完毕}
end;

接受答案了.