如何将数值转换为中文大写(100分)

如何将数值转换为中文大写，如：
123.45 壹佰贰拾叁元肆角伍分（位数去到亿位）

做个程序,如果没人回答你,明早我可以找到,
以前干过这事.

Sorry,dwwang,
抢先一步了,代码来自32位深度历险台湾钱达智先生
unit cutils;
interface
uses
SysUtils;
function CNum2Num(sChineseNum: string;
var dblArabic:do
uble): boolean;
function Num2CNum(dblArabic:do
uble): string;
implementation
(* -------------------------------------------------- *)
(* Num2CNum 将阿拉伯数字转成中文数字字串
(* 使用示例:
(* Num2CNum(10002.34) ==> 一万零二点三四
(*
(* Author: Wolfgang Chien <wolfgang@ms2.hinet.net>
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function Num2CNum(dblArabic:do
uble): string;
const
_ChineseNumeric = '零一二三四五六七八九';
var
sArabic: string;
sIntArabic: string;
iPosOfDecimalPoint: integer;
i: integer;
iDigit: integer;
iSection: integer;
sSectionArabic: string;
sSection: string;
bInZero: boolean;
bMinus: boolean;
(* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
function ConvertStr(const sBeConvert: string): string;
var
x: integer;
begin
Result := '';
for x := Length(sBeConvert)do
wnto 1do
AppendStr(Result, sBeConvert[x]);
end;
{ of ConvertStr }
begin
Result := '';
bInZero := True;
sArabic := FloatToStr(dblArabic);
(* 将数字转成阿拉伯数字字串 *)
{$ifdef __Debug}
ShowMessage('FloatToStr(dblArabic): ' + sArabic);
{$endif}
if sArabic[1] = '-' then
begin
bMinus := True;
sArabic := Copy(sArabic, 2, 254);
end
else
bMinus := False;
iPosOfDecimalPoint := Pos('.', sArabic);
(* 取得小数点的位置 *)
{$ifdef __Debug}
ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
{$endif}
(* 先处理整数的部分 *)
if iPosOfDecimalPoint = 0 then
sIntArabic := ConvertStr(sArabic)
else
sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
(* 从个位数起以每四位数为一小节 *)
for iSection := 0 to ((Length(sIntArabic) - 1) div 4)do
begin
sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
sSection := '';
(* 以下的 i 控制: 个十百千位四个位数 *)
for i := 1 to Length(sSectionArabic)do
begin
iDigit := Ord(sSectionArabic) - 48;
if iDigit = 0 then
begin
(* 1. 避免 '零' 的重覆出现 *)
(* 2. 个位数的 0 不必转成 '零' *)
if (not bInZero) and (i <> 1) then
sSection := '零' + sSection;
bInZero := True;
end
else
begin
case i of
2: sSection := '十' + sSection;
3: sSection := '百' + sSection;
4: sSection := '千' + sSection;
end;
sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
sSection;
bInZero := False;
end;
end;

(* 加上该小节的位数 *)
if Length(sSection) = 0 then
begin
if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
Result := '零' + Result;
end
else
begin
case iSection of
0: Result := sSection;
1: Result := sSection + '万' + Result;
2: Result := sSection + '亿' + Result;
3: Result := sSection + '兆' + Result;
end;
end;
{$ifdef __Debug}
ShowMessage('sSection: ' + sSection);
ShowMessage('Result: ' + Result);
{$endif}
end;

(* 处理小数点右边的部分 *)
if iPosOfDecimalPoint > 0 then
begin
AppendStr(Result, '点');
for i := iPosOfDecimalPoint + 1 to Length(sArabic)do
begin
iDigit := Ord(sArabic) - 48;
AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
end;
end;

{$ifdef __Debug}
ShowMessage('Result before 其他例外处理: ' + Result);
{$endif}
(* 其他例外状况的处理 *)
if Length(Result) = 0 then
Result := '零';
if Copy(Result, 1, 4) = '一十' then
Result := Copy(Result, 3, 254);
if Copy(Result, 1, 2) = '点' then
Result := '零' + Result;
(* 是否为负数 *)
if bMinus then
Result := '负' + Result;
{$ifdef __Debug}
ShowMessage('Result before Exit: ' + Result);
{$endif}
end;

(* -------------------------------------------------- *)
(* CNum2Num 将中文数字字串转成阿拉伯数字
(* 使用示例:
(* if CNum2Num('一千三百万零四十点一零三', dblTest)
(* dblTest ==> 13000040.103
(*
(* 注意事项:
(* 1. 转换成功, 函数传回 True;
否则为 False
(* 2. 不支援 '四万万' 等的说法, 必须为标准的记数方式
(*
(* Author: Wolfgang Chien <wolfgang@ms2.hinet.net>
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function CNum2Num(sChineseNum: string;
var dblArabic:do
uble): boolean;
const
_ChineseNumeric = '十百千万亿兆点零一二三四五六七八九';
{_ChineseNumeric = '1十3百5千7万9亿11兆13点15零17一19二21三四五六七八九';}
var
i: integer;
iPos: integer;
dblBuffer:do
uble;
sMultiChar: string;
iDigit: integer;
iRightOfDecimal: integer;
bMinus: boolean;
(* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
function EasyPower10(iPower: byte):do
uble;
var
i: integer;
begin
Result := 1;
try
for i := 1 to iPowerdo
Result := Result * 10;
except
Result := 0;
end;
end;
begin
Result := False;
dblArabic := 0;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := -1;
if Copy(sChineseNum, 1, 2) = '负' then
begin
sChineseNum := Copy(sChineseNum, 3, 254);
bMinus := True;
end
else
bMinus := False;
i := 1;
while i < Length(sChineseNum)do
begin
(* 如果不是中文字 ==> Fail *)
if sChineseNum < #127 then
Exit;
sMultiChar := Copy(sChineseNum, i, 2);
iPos := Pos(sMultiChar, _ChineseNumeric);
if iPos = 0 then
Exit;
if (iDigit = -1) and (iPos > 13) then
iDigit := (iPos - 15) div 2;
case iPos of
1, 3, 5:
begin
(* 十百千 *)
if iDigit = -1 then
iDigit := 1;
dblBuffer := dblBuffer + iDigit * EasyPower10((iPos + 1) div 2);
iDigit := -1;
end;
7, 9, 11:
begin
(* 万亿兆 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer * EasyPower10((iPos-5) div 2 * 4);
iDigit := -1;
dblBuffer := 0;
end;
13:
begin
(* 小数点 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
dblArabic := dblArabic + dblBuffer;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := 0;
end;
15: (* 零 *)
begin
if iRightOfDecimal > -1 then
Inc(iRightOfDecimal);
iDigit := -1;
end;
else
begin
if iRightOfDecimal > -1 then
begin
(* 小数点右边的部分 *)
Inc(iRightOfDecimal);
try
dblArabic := dblArabic + iDigit / EasyPower10(iRightOfDecimal);
except
Exit;
end;
iDigit := -1;
end;
end;
end;

{$ifdef __Debug}
ShowMessage(IntToStr(i) + 'th dblArabic: ' + FloatToStr(dblArabic));
ShowMessage(IntToStr(i) + 'th dblBuffer: ' + FloatToStr(dblBuffer));
ShowMessage(IntToStr(i) + 'th iDigit: ' + IntToStr(iDigit));
{$endif}
Inc(i, 2);
end;

if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer + iDigit;
if dblBuffer <> 0 then
dblArabic := dblArabic + dblBuffer;
if bMinus then
begin
{$ifdef __SafeMode}
sChineseNum := '负' + sChineseNum;
{$endif}
dblArabic := dblArabic * -1;
end;
{$ifdef __SafeMode}
Result := sChineseNum = Num2CNum(dblArabic);
{$else
}
Result := True;
{$endif}
end;

end.

比我还快,你真行! ^_^

老哥要求 1--壹 2--。。。。的转换，我的最合适。
给我加分啊！！！
unit money;
interface
uses Dialogs;
procedure formatmoney(je:real;var hzje:string) ;
implementation
function tochina(num:integer) char;
begin
case num of
0:
result:='零';
1:
result:='壹';
2:
result:='贰';
3:
result:='叁';
4:
result:='肆';
5:
result:='伍';
6:
result:='陆';
7:
result:='柒';
8:
result:='捌';
9:
result:='玖';
end;
end;

procedure formatmoney(je:real;var hzje:string) ;
var
i,j,inttmp:integer;
strtmp :array[1..21] of pchar;
flag:boolean;
begin
if je<=0.00 then
begin
hzje:='零';
exit;
end;
if je>99999999.99 then
begin
hzje:='零';
showmessage('金额超出范围! (je>99999999.99 in money --formatmoney)');
exit;
end;
hzje:='';
inttmp:=(round(je*100)) div 1 ;
strtmp[1]:='零';
strtmp[2]:='仟';
strtmp[3]:='零';
strtmp[4]:='佰';
strtmp[5]:='零';
strtmp[6]:='拾';
strtmp[7]:='零';
strtmp[8]:='万';
strtmp[9]:='零';
strtmp[10]:='仟';
strtmp[11]:='零';
strtmp[12]:='佰';
strtmp[13]:='零';
strtmp[14]:='拾';
strtmp[15]:='零';
strtmp[16]:='圆';
strtmp[17]:='零';
strtmp[18]:='角';
strtmp[19]:='零';
strtmp[20]:='分';
strtmp[21]:='整';
// 千零百零拾零万零千零百零拾零圆零角零分整';
for i:=1 to 10do
begin
if inttmp mod 10 <>0 then
begin
strtmp[21-i*2]:= tochina(inttmp mod 10);
end;
inttmp:=inttmp div 10;
if inttmp=0 then
break;
end;
hzje:='';
j:=21-i*2;
i:=j;
flag:=false;
while i<21do
begin
if (strtmp='零') then
begin
i:=i+1;
flag:=true;
if (strtmp='万') or (strtmp='圆') then
begin
hzje:=hzje+strtmp;
end;
end
else
begin
if flag then
begin
hzje:=hzje+'零';
flag:=false;
end;
// if (j<>5) and (j<>13)or (strtmp<>'壹') then
hzje:=hzje+strtmp;
i:=i+1;
hzje:=hzje+strtmp;
end;
i:=i+1;
end;
if ((round(je*100)) div 1) mod 10 = 0 then
hzje:=hzje+'整';
end;

end.

立马写一个，快试一下，合不合意！ 8-）.
function FourNumToChnNum(Str:string;ChnNum:string):string;
const
ChnNum2='零壹贰叁肆伍陆柒捌玖';
var
i,j,Len:integer;
s1,s2,s3,s:string;
Pre : Boolean;
begin
Result := '';
Len := Length(str) ;
Pre := False;
if StrToInt(Str)<>0 then
begin
for i:=1 to Lendo
begin
s1 := Copy(str,i,1);
s2 := Copy(ChnNum,(Len - i) * 2+1,2);
j := Ord(s1[1])-48;
s3 := Copy(ChnNum2,j*2+1,2);
if j=0 then
begin
if not Pre and (i<>Len) then
begin
Result := Result + s3;
Pre := True;
end;
end else
begin
Result := Result + s3 + Trim(s2);
Pre := False;
end;
end;
end;
end;

function NumToChnNum(str:string):string;
// 调用这个函数
const
ChnNum1='元万亿兆';
var
i,j,Len,Len1,Level,Start:integer;
s1,s2,s3,s,PreStr:string;
Zero,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;
for i := 1 to Leveldo
begin
s := Copy(str,Start,Len1);
s1 := FourNumToChnNum(s,' 拾佰仟');
// 注意有两个空格
if s1<>'' then
begin
Result := Result + s1 + Copy(ChnNum1,(Level-i)*2+1,2);;
end;
Start := Start + Len1;
Len1 := 4;
end;
Result := Result + FourNumToChnNum(Copy(str,Len+2,2),'分角');
end;

不好，我放上去的“不等于”符号都看不见了！

再发一遍。
function FourNumToChnNum(Str:string;ChnNum:string):string;
const
ChnNum2='零壹贰叁肆伍陆柒捌玖';
var
i,j,Len:integer;
s1,s2,s3,s:string;
Pre : Boolean;
begin
Result := '';
Len := Length(str) ;
Pre := False;
if StrToInt(Str)&amp;lt&amp;gt0 then
begin
for i:=1 to Lendo
begin
s1 := Copy(str,i,1);
s2 := Copy(ChnNum,(Len - i) * 2+1,2);
j := Ord(s1[1])-48;
s3 := Copy(ChnNum2,j*2+1,2);
if j=0 then
begin
if not Pre and (i&amp;lt&amp;gtLen) then
begin
// ***
Result := Result + s3;
Pre := True;
end;
end else
begin
Result := Result + s3 + Trim(s2);
Pre := False;
end;
end;
end;
end;

function FNumToChnNum(str:string):string;
// 123.45
const
ChnNum1='元万亿兆';
var
i,j,Len,Len1,Level,Start:integer;
s1,s2,s3,s,PreStr:string;
Zero,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;
for i := 1 to Leveldo
begin
s := Copy(str,Start,Len1);
s1 := FourNumToChnNum(s,' 拾佰仟');
// 注意有两个空格
if s1&amp;lt&amp;gt'' then
begin
Result := Result + s1 + Copy(ChnNum1,(Level-i)*2+1,2);;
end;
Start := Start + Len1;
Len1 := 4;
end;
Result := Result + FourNumToChnNum(Copy(str,Len+2,2),'分角');
end;

我来迟........了! 我也试了一个, 最后我也不知道能算到几位了
Function RMB(const ORMB :Real):String;
Const odxc='分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟亿';
odxs='零壹贰叁肆伍陆柒捌玖';
Var oszc,oscc,oscc0,L:String;
oi,oi0:Integer;
KRMB:Real;
begin
oszc:='';
KRMB:=abs(ormb);
str(KRMB:20:2,OSZC);
oszc:=replacestr(oszc,'.','');
oszc:=trim(oszc);
oscc:='';
oi:=length(oszc);
oi0:=0;
while oi>0do
begin
oscc:=COPY(odxc,oi0*2+1,2)+oscc;
oscc:=COPY(odxs,StrToInt(COPy(oszc,oi,1))*2+1,2)+oscc;
oi:=oi-1;
oi0:=oi0+1;
end;
oscc0:='';
oi:=1;
while oi<length(oscc)do
begin
if Copy(oscc,oi,2)='零' then
begin
If (COPy(oscc,oi+2,2)='万') and (right(oscc0,4)<>'亿零') then
begin
If right(oscc0,2)='零' then
oscc0:=left(oscc0,length(oscc0)-2)+'万'
else
oscc0:=oscc0+'万' ;
end else
If Copy(oscc,oi+2,2)='圆' then
begin
If right(oscc0,2)='零' then
oscc0:=left(oscc0,length(oscc0)-2)+'圆'
else
oscc0:=oscc0+'圆';
end else
If Copy(oscc,oi+2,2)='亿' then
begin
If right(oscc0,2)='零' then
oscc0:=left(oscc0,length(oscc0)-2)+'亿'
else
oscc0:=oscc0+'亿';
end else
If right(oscc0,2)<>'零' then
begin
oscc0:=oscc0+'零';
end;
end else
oscc0:=oscc0+Copy(oscc,oi,4) ;
oi:=oi+4;
end;
L:=right(oscc0,4);
If L='圆零' then
oscc0:=Copy(oscc0,1,length(oscc0)-2)+'整'
else
if L='角零' then
oscc0:=Copy(oscc0,1,length(oscc0)-2)+'整'
else
If right(oscc0,2)='零' then
oscc0:=Copy(oscc0,1,length(oscc0)-2)+'圆整';
result:=oscc0;
end;

这是我写的较短点:
function toChgZongNO(oono: real): string;
const
zongstr = '零壹贰叁肆伍陆柒捌玖';
const
zongwei = '佰拾万仟佰拾元角分';
var
ootno: string;
i, k: integer;
tmpstr: string;
begin
ootno := inttostr(trunc(oono * 100 + 0.5));
tmpstr := '';
for i := 1 to length(ootno)do
begin
k := strtoint(copy(ootno, i, 1));
tmpstr := tmpstr + ' ' + copy(zongstr, (k * 2 + 1), 2);
tmpstr := tmpstr + ' ' + copy(zongwei, (9 - length(ootno) + i) * 2 - 1, 2);
end;
result := tmpstr;
end;

对本人提供的函数再补充几点：
1、FNumToChnNum函数的参数为String型，如要用Real型，可用以下过程先将
Real型转换成String。
Str(X [: Width [: Decimals ]];
var S);
2、用“圆”代替“元”。
修改FNumToChnNum函数的ChnNum1常量。
3、对分、角全为零的情况，在尾部加上“整”。
可将FNumToChnNum函数的最后语句：
Result := Result + FourNumToChnNum(Copy(str,Len+2,2),'分角');
改为：
s1 := FourNumToChnNum(Copy(str,Len+2,2),'分角');
if s1 = '' then
s1 := '整';
Result := Result + s1 ;
还有什么要求？

怎么没下文了？

来晚了一步，白天进不来，晚上进来了，好题都没了
看来当个大富翁还得去找条CERNET专线才行
:-((

好！大家热情很高，可是提问人却无声响，why?!

这个问题没有挑战性，写个转换日期的，且解决2000年问题的，怎么样？

不会吧！！！！
这个问题也写了这么长的程序？？
今晚我写一个试试！不信搞不定！

CJ 说的对, 确实没有挑战性

知不知道为什么写了那么多？
人人都会写嘛，接着我的来，会有一点意思！

多人接受答案了。

OK,根据yysun的提醒,补充一个说明.
上述程序我都试验过了,除了jiangtao(钱达智先生的程序)
及littlegrass的答案之外,其他的都无法运行(不要告诉我还得提你们改错哟!)
钱先生的程序显然经过千锤百炼,我没有找到一丝破绽,
只是没有金额的汉字,想来原本不只是用来算钱的 ^_^
littlegrass的程序也基本正确,而且也有金额的表示,
就是有一点点没有过关--
用'10001008001.12'输入,变成了: 壹佰零亿零壹佰零万捌仟零壹元壹角贰分;
而钱先生的程序结果则为:一百亿零一百万八千零一点一二,显然是完全正确的.
怎么样,让我当分摊主,大家足够放心的吧?