高分求人民币金额小写转换为大写算法(300分)

好了，这个大家就收藏并存档作为历史了，
代码，标准，什么都全了~！

又改了一下，应该完全符合要求了，只可惜手头还没有Delphi，只能
拿C的给你参考

测试样例如下：
12345.67 人民币壹万贰千叁佰肆拾伍园陆角柒分
12303004.03 人民币壹千贰佰叁拾万叁千零肆园零叁分
12300000.00 / 12300000 人民币壹千贰佰叁拾万园整
100.02 人民币壹佰园零贰分
100.20 人民币壹佰园贰角
120000340056.07 人民币壹千贰佰亿零叁拾肆万零伍拾陆园零柒分


/*-----------------------------------------------------------------*/
CString SmallToBig(const CString&amp
szCurrency)
{
int dotPos = szCurrency.Find(".",0);// 从左起小数点的位置
if ( -1 == dotPos ) // 没有找到小数点
dotPos = szCurrency.GetLength();
CString szInt;
CString szFlt;
szInt = szCurrency.Left(dotPos);
szFlt = szCurrency.Right( szCurrency.GetLength() - dotPos -1 );
if ( (szFlt.GetLength()!=2) &&amp
(szFlt.GetLength()!=0)) return "";
// 小数点后必须有两位或者根本没有

CString t_unit1[5] = {"园", "万", "亿", "万", "亿"};
CString t_unit2[3] = {"拾", "佰", "千"};
CString t_unit3[2] = {"角", "分"};
CString t_num[10] = { "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖"};

CString sInt = "";

// 处理整数部分
int old_inx_num = 0;
for ( int i = 0
i < szInt.GetLength()
i++ )
{
char x = 0;
int inx_num = szInt[ szInt.GetLength() - i -1 ] - '0';// 将字符映射到数字
int inx_unit;

if ( i % 4 == 0 )
{
inx_unit = i / 4;
if (inx_num)
sInt = t_num[ inx_num ] + t_unit1[ inx_unit ] + sInt

else
sInt = t_unit1[ inx_unit ] + sInt;
}
else
{
inx_unit = i % 4 - 1;
if (inx_num)
sInt = t_num[ inx_num ] + t_unit2[ inx_unit ] + sInt

else
if (old_inx_num)
sInt = t_num[ inx_num ] + sInt;
}
old_inx_num = inx_num;
}

// 处理小数部分
CString sFlt = "";
if ( ( szFlt!="" )&amp;&amp;( szFlt!="00" ) )
{
for (int i = 0
i < 2
i++)
{
int inx_num = szFlt - '0';
if (inx_num)
sFlt = sFlt + t_num[inx_num] + t_unit3;
else
if ( i != 1) // 如果"分"是 0, 则忽略
sFlt = sFlt + t_num[inx_num];
}
return "人民币" + sInt + sFlt;
}
else
{
return "人民币" + sInt + "整";
}
}

刚才又发现还有问题 输入 0.07时结果是人民币圆零柒分

要吐血了，把前面的C改写成了Delphi版，修改了bug, 通过以下几个新的测试

0 / 0.00 人民币零圆整
0.10 人民币壹角
0.01 人民币壹分
0.11 人民币壹角壹分

const
t_num: array[0..9] of string[2] = ('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
t_unit1: array[0..4] of string[2] = ( '圆', '万', '亿','万', '亿');
t_unit2: array[0..2] of string[2] = ( '拾', '佰', '仟');
t_unit3: array[0..1] of string[2] = ( '角', '分');

function SmallToBig ( szCurrency: string ): string;
var dotPos:integer;
szInt:string
// 小写的整数部分
szFlt:string
// 小写的小数部分
sInt:string
// 大写的整数部分
sFlt:string
// 大写的小数部分
old_inx_num :integer;
inx_num :integer;
inx_unit :integer;
i: integer;
bOnlyFlt:Boolean;
begin

dotPos := Pos('.', szCurrency);
if dotPos <> 0 then
begin
szInt := Copy(szCurrency, 0, dotPos - 1 );
szFlt := Copy(szCurrency, dotPos + 1, 2);
end
else
begin
szInt := szCurrency;
szFlt := '';
end;

if ( ( szInt = '0' ) and (( szFlt = '00' ) or ( szFlt = '')) ) then
begin
result := '人民币零圆整';
exit;
end;

if ( szInt = '0' ) then bOnlyFlt := true
// 如果整数部分为零


if ( (Length(szFlt) <> 2) and ( dotPos <> 0)) then
// 小数点后必须有两位或者根本没有
begin
result := '';
exit;
end;

if ( not bOnlyFlt ) then // 如果整数部分为零，则不对其进行处理
for i := 0 to Length(szInt) - 1 do
begin
inx_num := StrToInt( szInt[ Length(szInt) - i ] );
if i mod 4 = 0 then
begin
inx_unit := i div 4;
if ( inx_num > 0 ) then
sInt := t_num[ inx_num ] + t_unit1[ inx_unit ] + sInt
else
sInt := t_unit1[ inx_unit ] + sInt;
end
else
begin
inx_unit := i mod 4 - 1;
if inx_num > 0 then
sInt := t_num[ inx_num ] + t_unit2[ inx_unit ] + sInt
else
if old_inx_num > 0 then
sInt := t_num[ inx_num ] + sInt;
end;
old_inx_num := inx_num;
end;

//处理小数部分
if ( ( szFlt <> '' ) and ( szFlt <> '00' ) ) then
begin
for i := 0 to 1 do
begin
inx_num := StrToInt(szFlt[i + 1]);
if (inx_num > 0) then
sFlt := sFlt + t_num[inx_num] + t_unit3
else
if ( i <> 1) then // 如果"角"为0 ("分"是 0, 则忽略)
if ( not bOnlyFlt ) then // 如果整数部分此时不为零
sFlt := sFlt + t_num[inx_num];
end;
result := '人民币' + sInt + sFlt;
end
else
begin
result := '人民币' + sInt + '整';
end
end;

to cheka:
上面的代码好象还是有点问题，超过亿后就不对了。
100000000
应为：人民币壹亿圆整
而上面的代码超换为：人民币壹亿万圆整

>to gxx:
你说的是符合银行的财务标准吧，昨天贴的两个贴子都犯了点小错误，因此我修改了一下，
供以后的朋友参考吧。
Function XiaoxieToDaxie(f : String) : String;
var
Fs,dx,d2,zs,xs,h,jg:string;
i,ws,{l,}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) downto 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 jg:= copy(jg,1,j+1)+copy(jg,j+4,200);

j := AnsiPos('零分',jg);
if j>0 then jg := copy(jg,1,j-1)+copy(jg,j+4,200)
End
else
jg := jg + '元整';
result := fs+jg;
end;

to commons_sheng:
又出现新问题，输入107000.53时出现乱码。先直接转换，后期再
处理字符串的算法好象不太可靠。

to cheka:
我仔细研究了一下你的代码，觉得这个算法比较可靠，至少在亿元以内
未发现问题，超过亿元后
if i mod 4 = 0 then
begin
inx_unit := i div 4;
if ( inx_num > 0 ) then
sInt := t_num[ inx_num ] + t_unit1[ inx_unit ] + sInt
else
sInt := t_unit1[ inx_unit ] + sInt;//这行代码就出问题了
end
变成了“亿万圆”，多出了一个“万”，如果解决此问题，我想这应该算是一个
比较完美的方案了吧！
前面的转换标准，值得认真研究。希望这次讨论能出现一个完美方案，以作收藏。

继续关注。。。。。。。

范围最好不要超过万亿的小写转大写，可能还有错误，望指正
Function XiaoxieToDaxie(f : String) : String;
var
Fs,dx,d2,zs,xs,h,jg:string;
i,ws,{l,}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) downto 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;

个你一个单元,,调用getrmb



unit common;

interface
uses classes, SysUtils, Dialogs;

//金额转换为人民币大写
function GetRMB(je: Real): string;
function ChinaNumber(Num: Integer): string;
function GetRMBIndex(T: string): Integer;

implementation

function GetRMBIndex(T: string): Integer;
var
UpperRMB: TStringList;
i: Integer;
begin
Result := -1;
UpperRMB := TStringList.Create;
try
UpperRMB.Add('元');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('千');
UpperRMB.Add('万');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('千');
UpperRMB.Add('亿');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('千');
UpperRMB.Add('万');
for i := 0 to UpperRMB.count - 1 do
if T = UpperRMB.Strings then begin
Result := I;
Break;
end;
finally
UpperRMB.free;
end;
end;

function GetRMB(je: Real): string;
var
TempStr, TempRMB: string;
Temp: string;
TempPrio, TempNext: Integer;
cur_pos: Integer;
i: Integer;
UpperRMB: TStringList;
begin
try
UpperRMB := TStringList.Create;
// UpperRMB.Add('');
UpperRMB.Add('元');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('仟');
UpperRMB.Add('万');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('千');
UpperRMB.Add('亿');
UpperRMB.Add('拾');
UpperRMB.Add('佰');
UpperRMB.Add('千');
UpperRMB.Add('万');
if je = 0 then begin
Result := '';
Exit;
end;
i := 0;
TempStr := FloatToStr(je);
cur_pos := pos('.', TempStr);
if cur_pos > 0 then begin
TempRMB := copy(TempStr, cur_pos + 1, 1);
if TempRMB = '0' then
Temp := '零'
else
Temp := ChinaNumber(StrToInt(TempRMB)) + '角';
TempRMB := copy(TempStr, cur_pos + 2, 1);
if TempRMB <> '' then
Temp := Temp + ChinaNumber(StrToInt(TempRMB)) + '分';
TempStr := copy(TempStr, 1, cur_pos - 1);
end;
for i := 1 to length(TempStr) do begin
TempRMB := copy(TempStr, Length(TempStr), 1);
if TempRMB = '0' then begin
if ((i - 1) mod 4) = 0 then begin
if copy(Result, 1, 2) <> '零' then
Result := '零' + UpperRMB.Strings[I - 1] + Result
else
Result := UpperRMB.Strings[I - 1] + Result;
end
else begin
if copy(Result, 1, 2) <> '零' then
Result := '零' + Result;
end;
end
else
Result := ChinaNumber(StrToInt(TempRMB)) + UpperRMB.Strings[I - 1] + Result;
TempStr := copy(TempStr, 1, Length(TempStr) - 1);
end;
cur_pos := pos('零', Result);
TempStr := '';
while cur_pos > 0 do begin
if TempStr = Result then Break;
TempStr := Result;
TempPrio := GetRMBIndex(copy(Result, cur_pos - 2, 2));
TempNext := GetRMBIndex(copy(Result, cur_pos + 2, 2));
if (TempPrio < TempNext) then delete(Result, cur_pos, 2)
else begin
if (copy(Result, cur_pos - 2, 2) = '亿') and (copy(Result, cur_pos + 2, 2) = '万') then
delete(Result, cur_pos, 4);
if copy(Result, cur_pos + 2, 2) = '' then delete(Result, cur_pos, 2);
end;
cur_pos := pos('零', Result);
end;
if copy(Result, length(result) - 3, 2) = '零' then
delete(result, length(result) - 3, 2);
Result := Result + Temp;
finally
UpperRMB.Free;
end;
end;

function ChinaNumber(Num: Integer): string;
begin
case Num of
1: Result := '壹';
2: Result := '贰';
3: Result := '叁';
4: Result := '肆';
5: Result := '伍';
6: Result := '陆';
7: Result := '柒';
8: Result := '捌';
9: Result := '玖';
0: Result := '零';
else
MessageDlg('数字输入错误!', mtError, [mbOK], 0);
end;
end;

end.

那个bug解决了，现在一直到一千亿亿元都没有类似问题（再往上没意义了吧？）
不过百密终有一疏啊，gxx 你再多测试一些


100000000000 人民币一千亿元整
100000000000.01 人民币一千亿元零一分
10000000000000 人民币一十万亿元整
1010100000000000 人民币一千零一十万一千亿元整
10000000000000000 人民币一亿亿元整
10000000000000000000 人民币一千亿亿元整
1234567898765432.10
人民币壹仟贰佰叁拾肆万伍仟陆佰柒拾捌亿玖仟捌佰柒拾陆万伍仟肆佰叁拾贰圆壹角



const
t_num: array[0..9] of string[2] = ('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
t_unit1: array[0..4] of string[2] = ( '圆', '万', '亿','万', '亿');
t_unit2: array[0..2] of string[2] = ( '拾', '佰', '仟');
t_unit3: array[0..1] of string[2] = ( '角', '分');

function SmallToBig ( szCurrency: string ): string;
var dotPos:integer;
szInt:string
// 小写的整数部分
szFlt:string
// 小写的小数部分
sInt:string
// 大写的整数部分
sFlt:string
// 大写的小数部分
old_inx_num :integer;
inx_num :integer;
inx_unit :integer;
i: integer;
bOnlyFlt:Boolean;
begin

dotPos := Pos('.', szCurrency);
if dotPos <> 0 then
begin
szInt := Copy(szCurrency, 0, dotPos - 1 );
szFlt := Copy(szCurrency, dotPos + 1, 2);
end
else
begin
szInt := szCurrency;
szFlt := '';
end;

if ( ( szInt = '0' ) and (( szFlt = '00' ) or ( szFlt = '')) ) then
begin
result := '人民币零圆整';
exit;
end;

if ( szInt = '0' ) then bOnlyFlt := true
// 如果整数部分为零


if ( (Length(szFlt) <> 2) and ( dotPos <> 0)) then
// 小数点后必须有两位或者根本没有
begin
result := '';
exit;
end;

if ( not bOnlyFlt ) then // 如果整数部分为零，则不对其进行处理
for i := 0 to Length(szInt) - 1 do
begin
inx_num := StrToInt( szInt[ Length(szInt) - i ] );
if i mod 4 = 0 then
begin
inx_unit := i div 4;
if ( inx_num > 0 ) then
// 以下判断处理诸如"壹亿圆"，“壹亿亿圆"
if ( (inx_unit > 0) and (inx_unit mod 2 = 0) and (sInt[1]+sInt[2] = '万') ) then
sInt := t_num[ inx_num ] + t_unit1[ inx_unit ] + copy(sInt,3,2*(Length(sInt)-1))
else
sInt := t_num[ inx_num ] + t_unit1[ inx_unit ] + sInt
else
// 以下判断处理诸如"壹拾亿圆“，"壹拾亿亿圆"
if ( (inx_unit > 0) and (inx_unit mod 2 = 0) and (sInt[1]+sInt[2] = '万') ) then
sInt := t_unit1[ inx_unit ] + copy(sInt,3,2*(Length(sInt)-1))
else
sInt := t_unit1[ inx_unit ] + sInt;
end
else
begin
inx_unit := i mod 4 - 1;
if inx_num > 0 then
sInt := t_num[ inx_num ] + t_unit2[ inx_unit ] + sInt
else
if old_inx_num > 0 then
sInt := t_num[ inx_num ] + sInt;
end;
old_inx_num := inx_num;
end;

//处理小数部分
if ( ( szFlt <> '' ) and ( szFlt <> '00' ) ) then
begin
for i := 0 to 1 do
begin
inx_num := StrToInt(szFlt[i + 1]);
if (inx_num > 0) then
sFlt := sFlt + t_num[inx_num] + t_unit3
else
if ( i <> 1) then // 如果"角"为0 (分"是 0, 则忽略)
if ( not bOnlyFlt ) then // 如果整数为此时为零
sFlt := sFlt + t_num[inx_num];
end;
result := '人民币' + sInt + sFlt;
end
else
begin
result := '人民币' + sInt + '整';
end
end;

[][green][/green]看看哥们的，绝对好用！

function SmallTOBig(small: real): string;
var
SmallMonth, BigMonth: string;
wei1, qianwei1: string[2];
qianwei, dianweizhi, qian: integer;
fs_bj: boolean;
begin
if small < 0 then
fs_bj := True
else
fs_bj := False;
small := abs(small);
{------- 修改参数令值更精确 -------}
{小数点后的位置，需要的话也可以改动-2值}
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(Smallmonth[qian]) 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;

BigMonth := FastReplace(BigMonth, '零拾', '零', False);
BigMonth := FastReplace(BigMonth, '零佰', '零', False);
BigMonth := FastReplace(BigMonth, '零仟', '零', False);
BigMonth := FastReplace(BigMonth, '零角零分', '', False);
BigMonth := FastReplace(BigMonth, '零角', '零', False);
BigMonth := FastReplace(BigMonth, '零分', '', False);
BigMonth := FastReplace(BigMonth, '零零', '零', False);
BigMonth := FastReplace(BigMonth, '零零', '零', False);
BigMonth := FastReplace(BigMonth, '零零', '零', False);
BigMonth := FastReplace(BigMonth, '零亿', '亿', False);
BigMonth := FastReplace(BigMonth, '零万', '万', False);
BigMonth := FastReplace(BigMonth, '零元', '元', False);
BigMonth := FastReplace(BigMonth, '亿万', '亿', False);
BigMonth := BigMonth + '整';
BigMonth := FastReplace(BigMonth, '分整', '分', False);
if BigMonth = '元整' then
BigMonth := '零元整';
if copy(BigMonth, 1, 2) = '元' then
BigMonth := copy(BigMonth, 3, length(BigMonth) - 2);
if copy(BigMonth, 1, 2) = '零' then
BigMonth := copy(BigMonth, 3, length(BigMonth) - 2);
if fs_bj = True then
SmallTOBig := '- ' + BigMonth
else
SmallTOBig := BigMonth;
end;


FastReplace 只是一个替换函数可用其他的替换

madm 的怎么和千堆雪一模一样 ：）

对各位高手的代码正在测试中.....

如果愿意给分的话(150),留下Email,我发源程序给你!!

to zcm1975117:
我查了一下，dfw上的贴子中就有7、8种方法（不算类似或雷同的），每种方法
都能实现大部分功能，我经过逐个测试，都有不完美的地方或bug。
cheka最后修改的代码，我正在测试，还未发现大的问题。

抱歉，我还没看到你的代码，怎么能先答应给分呢？

如果您不愿把代码贴出来，可以发信到：xxgao@263.net
不过我先声明，我要测试，确认没有bug才能给分。
如果有bug，我会写信通知你，给分多少，就要酌情啦！

保证你满意!

procedure delete0(var bigMonth: string);
begin
while pos('零仟', BigMonth) > 0 do
delete(BigMonth, pos('零仟', BigMonth) + 2, 2);

while pos('零佰', BigMonth) > 0 do
delete(BigMonth, pos('零佰', BigMonth) + 2, 2);

while pos('零拾', BigMonth) > 0 do
delete(BigMonth, pos('零拾', BigMonth) + 2, 2);

while pos('零零', BigMonth) > 0 do
delete(BigMonth, pos('零零', BigMonth), 2);
end;

function SmallTOBig(small: extended): string;
const
bigchar: array[0..9] of string[2] = ('零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');
bigNum: array[-2..11] of string[2] = ('分', '角', '元', '拾', '佰', '仟', '万', '拾', '佰', '仟', '亿',
'拾', '佰', '仟');
var
SmallMonth, BigMonth: string;
wei1, qianwei1: string[2];
qianwei, qian: integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位置，需要的话也可以改动-2值}
qianwei := -2;
{转换成货币形式，需要的话小数点后加多几个零}
Smallmonth := formatfloat('0.00', abs(small));
{---------------------------------}
delete(smallmonth, pos('.', Smallmonth), 1)
{小数点的位置}
{循环小写货币的每一位，从小写的右边位置到左边}
for qian := length(Smallmonth) downto 1 do
begin

{位置上的数转换成大写}
wei1 := bigchar[strtoint(copy(Smallmonth, qian, 1))];

{判断大写位置，可以继续增大到real类型的最大值}
qianwei1 := bigNum[qianwei];
inc(qianwei);
BigMonth := wei1 + qianwei1 + BigMonth
{组合成大写金额}
end;

delete0(bigmonth);

replacestr('零亿', '亿零', BigMonth);
delete0(bigmonth);

replacestr('零万', '万零', BigMonth);
delete0(bigmonth);

replacestr('零元', '元零', BigMonth);
delete0(bigmonth);

replacestr('零角', '零', BigMonth);
while pos('零零', BigMonth) > 0 do
delete(BigMonth, pos('零零', BigMonth), 2);

replacestr('零分', '整', BigMonth);

if (pos('整', BigMonth) <= 0) and (pos('分', BigMonth) <= 0) then
BigMonth := Bigmonth + '整';

result := BigMonth;
if small < 0 then
result := '负' + result;

end;

不好意思,我也仔细测试了一下,如果超过十亿以后,也有错误出现,等我修改好了再说吧!!!

看看我的吧,精确到亿
Function XxToDx(const hjnum:real):String;
var Vstr,zzz,cc,cc1,Presult:string

xxbb:array[1..12]of string;
uppna:array[0..9] of string

iCount,iZero,vPoint,vdtlno:integer

begin
//*设置大写中文数字和相应单位数组*//
xxbb[1]:='亿';
xxbb[2]:='仟'

xxbb[3]:='佰'

xxbb[4]:='拾';
xxbb[5]:='万'

xxbb[6]:='仟'

xxbb[7]:='佰'

xxbb[8]:='拾';
xxbb[9]:='元'

xxbb[10]:='.'

xxbb[11]:='角'

xxbb[12]:='分';
uppna[0]:='零'

uppna[1]:='壹'

uppna[2]:='贰'

uppna[3]:='叁';
uppna[4]:='肆'

uppna[5]:='伍'

uppna[6]:='陆'

uppna[7]:='柒';
uppna[8]:='捌'

uppna[9]:='玖'

Str(hjnum:12:2,Vstr)

cc:='';
cc1:=''

zzz:=''

result:=''

presult:='';
iZero:=0

vPoint:=0

for iCount:=1 to 10 do
begin
cc:=Vstr[iCount];
if cc<>' ' then
begin
zzz:=xxbb[iCount];
if cc='0' then
begin
if iZero<1 then //*对“零”进行判断*//
cc:='零'
else
cc:='';
if iCount=5 then //*对万位“零”的处理*//
if copy(result,length(result)-1,2)='零' then
Begin
if copy(result,Length(result)-3,2)<>'亿' then
result:=copy(result,1,length(result)-2)+xxbb[iCount]+'零';
End else
result:=result+xxbb[iCount];
cc1:=cc;
zzz:='';
iZero:=iZero+1;
end else
begin
if cc='.' then
begin
cc:='';
if (cc1='') or (cc1='零') then
begin
Presult:=copy(result,1,Length(result)-2);
result:=Presult;
iZero:=15;
end;
if iZero>=1 then
zzz:=xxbb[9]
else
zzz:='';
vPoint:=1;
end else
begin
iZero:=0;
cc:=uppna[StrToInt(cc)];
end
end;
result:=result+(cc+zzz)
end;
end;

If Vstr[11]='0' then //*对小数点后两位进行处理*//
begin
if Vstr[12]<>'0' then
begin
cc:='零';
result:=result+cc;
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(cc+xxbb[12]);
end
end else
begin
if iZero=15 then
{ begin
cc:='零';
result:=result+cc;
end;}
cc:=uppna[StrToInt(Vstr[11])];
result:=result+(cc+xxbb[11]);
if Vstr[12]<>'0' then
begin
cc:=uppna[StrToInt(Vstr[12])];
result:=result+(cc+xxbb[12]);
end;
end;
result:=result+'正';
end;

这个贴子还没有结束？//thinkhard

多人接受答案了。

兄弟们，答案有问题呀。
试试100000000是否显示一亿万元？
做个Form,加入一个TListView,写如下一段代码：
procedure TForm1.FormCreate(Sender: TObject);
var
V: Double;
I, J, K, N: Integer;
L: Int64;
begin
for I := 0 to 2048 do
begin
K := I;
V := 0;
L := 1;
while K > 0 do
begin
J := K and 1;
K := K shr 1;
N := Random(10000) mod 9 + 1;
if J > 0 then
V := V + N * L;
L := L * 10;
end;
V := V / 100;
with ListView1.Items.Add do
begin
Caption := Format('%.2f', [V]);
SubItems.Add(MoneyName(V))
//或改成测试用的函数
end;
end;
end;
如果每条记录都正确才能算正确。

这个版本应该是终结者：

function MoneyName(Value: Double): string;
const
SCnNumber = '零壹贰叁肆伍陆柒捌玖';
SCnPower = '拾佰仟';
var
V, V1: Double;
X: array[0..4] of Integer
//分别表示万亿位、亿位、万位、元位、分位
N, P, I, J: Integer
//内部使用
S: array[0..4] of string
//目标串
B: array[0..4] of Boolean
//是否零前缀
BK, BL: Boolean;
begin
V := Int(Value);
X[4] := Trunc((Value - V) * 100 + 0.5)
//分位
X[0] := 0
//万亿位
X[1] := 0
//亿位
X[2] := 0
//万位
X[3] := 0
//元位
I := 3;
while (V > 0) and (I >= 0) do
begin
V1 := Int(V / 10000) * 10000;
X := Trunc(V - V1);
Dec(I);
V := V1 / 10000;
end;
BL := True
//检查是否全为零
for I := 0 to 4 do
if X <> 0 then
begin
BL := False;
Break;
end;
if BL then
Result := '零元整'
else
begin
//先计算整数部分每节的串
for I := 0 to 3 do
begin
S := '';
if X > 0 then
begin
B := False;
P := 1000;
BK := False
//前位为零
BL := False
//未记录过
for J := 0 to 3 do
begin
N := X div P
//当前位
X := X - N * P
//剩余位
P := P div 10
//幂
if N = 0 then //当前位为零
begin
if J = 0 then
B := True //如果是最高位
else
if BL then //如果未记录过
BK := True;
end
else
begin
if BK then
S := S + '零';
BL := True;
S := S + Copy(SCnNumber, N * 2 + 1, 2);
if J < 3 then
S := S + Copy(SCnPower, (3 - J) * 2 - 1, 2);
BK := False;
end;
end;
end;
end;
//小数部分
BL := False;
if X[4] mod 10 > 0 then
S[4] := Copy(SCnNumber, (X[4] mod 10) * 2 + 1, 2) + '分'
else
begin
BL := True;
S[4] := '';
end;
X[4] := X[4] div 10;
if X[4] > 0 then
begin
S[4] := Copy(SCnNumber, (X[4] mod 10) * 2 + 1, 2) + '角' + S[4];
B[4] := False;
end
else
B[4] := not BL;
//合并串
Result := '';
BL := False;
for I := 0 to 3 do
if Length(S) > 0 then
begin
if BL then
if B then
Result := Result + '零';
Result := Result + S;
case I of
0, 2: Result := Result + '万';
1: Result := Result + '亿';
3: Result := Result + '元';
end;
BL := True;
end
else
if BL then
case I of
1: Result := Result + '亿';
3: Result := Result + '元';
end;
if Length(S[4]) = 0 then
Result := Result + '整'
else
begin
if B[4] then
if BL then
Result := Result + '零';
Result := Result + S[4];
end;
end;
end;