高分求购－－数字转换问题，非常简单。（捡分嘛！） (300分)

[blue][/blue]高分求购金额大小写转换代码

检
http://www.delphibbs.com/delphibbs/dispq.asp?lid=948751
http://www.delphibbs.com/delphibbs/dispq.asp?lid=457746
Function ChineseMoney(value:double):String;
var
SmallMoney,BigMoney:string;
wei1,qianwei1:string[2];
qianwei,dianweizhi,qian,number:Integer;
neg :Boolean;
begin
qianwei := -2 ;//小数点后的位置，这里为2位
neg := False;
SmallMoney := FormatFloat('0.00',value);
number := Length(SmallMoney);
if copy(trim(SmallMoney),1,1) ='-' then
begin
neg := True;
number := number -1;
SmallMoney := Copy(SmallMoney,2,number);
end;

dianweizhi := pos('.',SmallMoney);
for qian:= Length(SmallMoney)do
wnto 1do
//循环小写金额的每一位，从右到左
begin
if qian<>dianweizhi then
//如果读到的不是小数点就继续
begin
case StrToInt(Copy(SmallMoney,qian,1)) of
1:wei1 := '壹';
2:wei1 := '贰';
3:wei1 := '叁';
4:wei1 := '肆';
5:wei1 := '伍';
6:wei1 := '陆';
7:wei1 := '柒';
8:wei1 := '捌';
9:wei1 := '玖';
0:wei1 := '零';
end;
case qianwei of //判断大写位置
-3:qianwei1 :='厘';
-2:qianwei1 :='分';
-1:qianwei1 :='角';
0:qianwei1 :='元';
1,5,9:qianwei1 :='拾';
2,6,10:qianwei1 :='佰';
3,7,11:qianwei1 :='千';
4:qianwei1 :='万';
8:qianwei1 :='亿';
end;
inc (qianwei);
BigMoney := wei1+qianwei1+BigMoney;
//组合成大写金额
end;
end;
if neg then
Result := '负'+BigMoney
else
Result := BigMoney;
end;

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)do
wnto 1do

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;

好象网上有现成的控件带有原码的。记不得在哪里了。[8D]

http://www.playicq.com/dispdoc.asp?id=710
DFW论坛里有很多这样的源代码，你可以检索一下。我就是参照几个例子作了一个。

以上两位对 10000001.01 这样的数处理不好
'负壹佰零拾零万零千贰佰零拾壹元零角贰分'

ChnNum: array[0..9] of string =
('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
NumBit: array[1..15] of string =
('分','角','元','拾','佰','仟','万','拾','佰','仟',
'亿','拾','佰','仟','万');
function packcurrstring(astr:string):string;
var tmps:widestring;i:integer;
begin
tmps:=astr;
i:=1;
while i<length(tmps)do
begin
if tmps='零' then
begin
while pos(tmps[i+1],'零角拾佰仟')>0do
delete(tmps,i+1,1);
if pos(tmps[i+1],'元万亿')>0 then
begin
if i=1 then
begin
delete(tmps,i,2);
i:=0;
end else
delete(tmps,i,1);
end else
if tmps[i+1]='分' then
delete(tmps,i,2);
end;
inc(i);
end;
result:=tmps;
end;

function chncurrstring(astr:string):string;
var tmps:string;i,n,m:integer;
begin
n:=length(astr);
m:=n;
if astr[1]='-' then
dec(m);
tmps:='';
for i:=1 to mdo
tmps:=chnnum[ord(astr[n-i+1])-ord('0')]+numbit+tmps;
if m<>n then
tmps:='负'+tmps;
result:=tmps;
end;

function aa(Jine: Extended): string;
begin
Result := FormatFloat('0.00', Jine);
Delete(Result, Pos('.', Result), 1);
Result := ChnCurrString(Result);
Result := PackCurrString(Result);
if (Copy(Result, Length(Result) - 1, 2) <> '分')
and (Length(Result) > 1) then
Result := Result + '整';
end;

多人接受答案了。