小写金额转换成大写金额(50分)

哪位高手有已经测试过好用的小写金额转换成大写金额的程序,请赐教

http://www.playicq.com/dispdoc.php?t=&id=710

function TForm1.xTOd(i:Real):string;
const
d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
var
m,k:string;
j:integer;
begin
k:='';
m:=floattostr(int(i*100));
for j:=length(m) downto 1 do
k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+
d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2];
xTOd:=k;
end;

调用：
procedure TForm1.Button1Click(Sender: TObject);
var
Sum:real;
begin
sum:=12.34;
showmessage('人民币大写:'+xTOd(Sum));
end;

function SmallTOBig(small:real):string;
var
SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位数，需要的话也可以改动该值}
qianwei:=-2;
{转换成货币形式，需要的话小数点后加多几个零}
Smallmonth:=formatfloat('0.00',small);
{---------------------------------}
dianweizhi :=pos('.',Smallmonth);{小数点的位置}
{循环小写货币的每一位，从小写的右边位置到左边}
for qian:=length(Smallmonth) downto 1 do
begin
{如果读到的不是小数点就继续}
if qian<>dianweizhi then
begin
{位置上的数转换成大写}
case strtoint(copy(Smallmonth,qian,1)) of
1:wei1:='壹';
2:wei1:='贰';
3:wei1:='叁';
4:wei1:='肆';
5:wei1:='伍';
6:wei1:='陆';
7:wei1:='柒';
8:wei1:='捌';
9:wei1:='玖';
0:wei1:='零';
end;
{判断大写位置，可以继续增大到real类型的最大值，可是谁有那么多钱}
case qianwei of
-3:qianwei1:='厘';
-2:qianwei1:='分';
-1:qianwei1:='角';
0 :qianwei1:='元';
1 :qianwei1:='拾';
2 :qianwei1:='佰';
3 :qianwei1:='千';
4 :qianwei1:='万';
5 :qianwei1:='拾';
6 :qianwei1:='佰';
7 :qianwei1:='千';
8 :qianwei1:='亿';
9 :qianwei1:='十';
10:qianwei1:='佰';
11:qianwei1:='千';
end;
inc(qianwei);
BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
end;
end;
SmallTOBig:=BigMonth;
end;

楼上有bug:test 10000000

function Currency(rmb:real):string;
var s1,s2,s3,s4,dxs:string;
l,l1,l2,l3:integer;
begin
s1:='分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟万';
s2:='零壹贰叁肆伍陆柒捌玖';
l:=length(floattostr(rmb));
if copy(floattostr(rmb),l-2,1)='.' then
begin
dxs:=floattostr(abs(rmb));
end
else
begin
if copy(floattostr(rmb),l-1,1)='.' then
dxs:=floattostr(abs(rmb))+'0'
else
dxs:=floattostr(abs(rmb))+'.00'
end;
l1:=length(dxs);
dxs:=copy(dxs,1,l1-3)+copy(dxs,l1-1,2);
s3:='';
l2:=length(dxs);
l3:=0;
while l2>0 do
begin
s3:=copy(s1,l3*2+1,2)+s3;
s3:=copy(s2,strtoint(copy(dxs,l2,1))*2+1,2)+s3;
l2:=l2-1;
l3:=l3+1;
end;
s4:='';
l2:=1;
while l2<length(s3) do
begin
if copy(s3,l2,2)='零' then
begin
if copy(s3,l2+2,2)='万' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'万'
else
s4:=s4+'万';
end;
if copy(s3,l2+2,2)='圆' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'圆'
else
s4:=s4+'圆';
end;
if copy(s3,l2+2,2)='亿' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'亿'
else
s4:=s4+'亿';
end;
if copy(s4,length(s4)-1,2)<>'零' then
s4:=s4+'零';
end
else
s4:=s4+copy(s3,l2,4);
l2:=l2+4;
end;
if copy(s4,length(s4)-3,4)='圆零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-3,4)='角零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-1,2)='零' then
begin
s4:=copy(s4,1,length(s4)-2)+'圆整';
end;
Currency:=s4;
end;

测试了一个,以下这个可以用


function Currency(rmb:real):string;
var s1,s2,s3,s4,dxs:string;
l,l1,l2,l3:integer;
begin
s1:='分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟万';
s2:='零壹贰叁肆伍陆柒捌玖';
l:=length(floattostr(rmb));
if copy(floattostr(rmb),l-2,1)='.' then
begin
dxs:=floattostr(abs(rmb));
end
else
begin
if copy(floattostr(rmb),l-1,1)='.' then
dxs:=floattostr(abs(rmb))+'0'
else
dxs:=floattostr(abs(rmb))+'.00'
end;
l1:=length(dxs);
dxs:=copy(dxs,1,l1-3)+copy(dxs,l1-1,2);
s3:='';
l2:=length(dxs);
l3:=0;
while l2>0 do
begin
s3:=copy(s1,l3*2+1,2)+s3;
s3:=copy(s2,strtoint(copy(dxs,l2,1))*2+1,2)+s3;
l2:=l2-1;
l3:=l3+1;
end;
s4:='';
l2:=1;
while l2<length(s3) do
begin
if copy(s3,l2,2)='零' then
begin
if copy(s3,l2+2,2)='万' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'万'
else
s4:=s4+'万';
end;
if copy(s3,l2+2,2)='圆' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'圆'
else
s4:=s4+'圆';
end;
if copy(s3,l2+2,2)='亿' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'亿'
else
s4:=s4+'亿';
end;
if copy(s4,length(s4)-1,2)<>'零' then
s4:=s4+'零';
end
else
s4:=s4+copy(s3,l2,4);
l2:=l2+4;
end;
if copy(s4,length(s4)-3,4)='圆零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-3,4)='角零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-1,2)='零' then
begin
s4:=copy(s4,1,length(s4)-2)+'圆整';
end;
Currency:=s4;
end;

我有

function dxsz(const xssz,dxdw,dxqw:string):string;
var
dystr,destr:string;
begin
dystr := '';
destr := '';
if(dxqw ='零') then dystr := dxqw;
if(xssz = '9') then destr := '玖'+dxdw else
if(xssz = '8') then destr := '捌'+dxdw else
if(xssz = '7') then destr := '柒'+dxdw else
if(xssz = '6') then destr := '陆'+dxdw else
if(xssz = '5') then destr := '伍'+dxdw else
if(xssz = '4') then destr := '肆'+dxdw else
if(xssz = '3') then destr := '叁'+dxdw else
if(xssz = '2') then destr := '贰'+dxdw else
if(xssz = '1') then destr := '壹'+dxdw else
if(xssz <>'0') then destr := '' else
begin
dystr := '';
if(dxqw = '') then destr := '' else
if(dxdw ='分') then destr := '' else
if(dxdw ='角') then destr := '零'+dxdw else
if(dxdw ='元') then destr := dxdw
else destr := '零';
end;
Result := dystr+destr;
end;

function dxje(const xxje:string):string;
var
jestr,jgstr,dwstr,lsstr:string;
jeint,loopin:integer;
begin
result := jgstr;
dwstr := '';
//jestr := format('%f',[xxje]);
jestr := xxje;
jeint := pos('.', jestr);
if(jeint = 0)
then jeint := length(jestr)
else jeint := jeint -1;
for loopin:=1 to maxint do
begin
case jeint of
9: lsstr := dxsz(jestr[loopin], '亿' ,lsstr);
4,8: lsstr := dxsz(jestr[loopin], '仟' ,lsstr);
3,7: lsstr := dxsz(jestr[loopin], '佰' ,lsstr);
2,6: lsstr := dxsz(jestr[loopin], '拾' ,lsstr);
5: lsstr := dxsz(jestr[loopin], '万' ,lsstr);
1: lsstr := dxsz(jestr[loopin], '元' ,lsstr);
end;
if(lsstr = '') then else
if(lsstr ='零') then
else jgstr := jgstr +lsstr;
jeint := jeint -1;
if(jeint < 1) then break;
end;
{}
jeint := pos('.', jestr);
if(Strtoint(copy(jestr, jeint+1, maxint)) <> 0) then
for loopin:=1 to 2 do
begin
case loopin of
1: jgstr := jgstr +dxsz(jestr[loopin+jeint], '角' ,'');
2: jgstr := jgstr +dxsz(jestr[loopin+jeint], '分' ,'');
3: jgstr := jgstr +dxsz(jestr[loopin+jeint], '厘' ,'');
end;
end;
{}
if(jgstr <> '') then jgstr := jgstr +'整';
Result := jgstr;
end;

多人接受答案了。

不错！