数值变大写人民币金额的问题(100分)

各位大侠，我急需《数值变大写人民币金额》的源代码，请支援吧
我的email:ybjames@21cn.com

function thkd.sz2hz(sztmp:string):string;
var
i,n,have0:integer;
hzstr,hztmp,szstr,bwhz,m2w:string;
//hzstr='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万亿兆整':string;
//hzdwc='分角元拾佰仟万拾佰仟亿拾佰仟兆拾佰仟':string;
const
hzdw='分角元拾佰仟万拾佰仟亿拾佰仟兆拾佰仟';
hz0='零';
hz1='壹';
hz2='贰';
hz3='叁';
hz4='肆';
hz5='伍';
hz6='陆';
hz7='柒';
hz8='捌';
hz9='玖';
hzdwf='分';
hzdwj='角';
hzdwy='元';
hz10='拾';
hzb='佰';
hzq='仟';
hzw='万';
hzy='亿';
hzz='兆';

begin
result:='';
n:=length(sztmp);
if n<4 then
begin
result:='长度不够';exit;
end;
if n>18 the begin
result:='数字串超长';exit;
end;
//去掉小数点
if (sztmp[n-2]<>'.') then
begin
result:='数字串格式不对';exit;
end
else
begin
szstr:=copy(sztmp,1,n-3)+copy(sztmp,n-1,2);
n:=n-1;
end;
hztmp:='';
for i:=1 to ndo
begin
case szstr of
'0':bwhz:=hz0;
'1':bwhz:=hz1 ;
'2':bwhz:=hz2 ;
'3':bwhz:=hz3 ;
'4':bwhz:=hz4 ;
'5':bwhz:=hz5 ;
'6':bwhz:=hz6 ;
'7':bwhz:=hz7 ;
'8':bwhz:=hz8 ;
'9':bwhz:=hz9 ;
else
begin
result:='数字串非法';
exit;
end;
end;
hztmp:=hztmp+bwhz+copy(hzdw,2*(n-i)+1,2);
end;

//result:=hzdw[3]+hzdw[4];
//result:=hztmp;
//exit;
if (n=3) and (szstr[1]='0') {0.xx}
then
begin
if szstr[n-1]='0'{0.0x}
then
if szstr[n]='0'{0.00} then
result:='零元'
{0.0X} else
result:=copy(hztmp,4*n-3,4)
{szstr[n-1]<>'0'}else
if szstr[n]='0'{0.X0} then
result:=copy(hztmp,4*(n-1)-3,4)+'整'
{0.XX} else
result:=copy(hztmp,4*(n-1)-3,8);
exit;
end;
//末尾2位的汉字串{小数部分}
if szstr[n-1]='0' then
if szstr[n]='0' then
m2w:='整' {.00}
else
m2w:='零'+copy(hztmp,4*n-3,4){.0X}
{szstr[n-1]<>'0'} else
if szstr[n]='0' then
m2w:=copy(hztmp,4*(n-1)-3,4)+'整'{.X0}
else
m2w:=copy(hztmp,4*(n-1)-3,8);{.XX}
have0:=0;
hzstr:='';
// {整数部分:XXXX, XXXX, XXXX, XXXX.}
{第 4， 3， 2， 1.部分}
for i:=1 to n-2do
{从高位向低位读}
begin
if szstr='0' then
begin
{1}
inc(have0);
{有0则HAVE0加1}
if ((i=n-2)or(i=n-6)or (i=n-10) or (i=n-14)) {如果个（元）位、万位、亿位、兆位为0}
then
begin
if have0=1 then
hzstr:=hzstr+copy(hztmp,4*i-1,2){仅该位为0}
else
begin
{前几位有0}
{个位} If (i=n-2) then
hzstr:=copy(hzstr,1,length(hzstr)-2)+copy(hztmp,4*i-1,2){'元'}
else
if have0=4 then
begin
{第2或3，4部分全为0}
if szstr[i+1]='0' then
{后一部分第一位为0}
{从HZSTR中删除‘零’字} hzstr:=copy(hzstr,1,length(hzstr)-2);
end
{该部分仅后几位为0，删除‘零’字并加单位} else
begin
hzstr:=copy(hzstr,1,length(hzstr)-2)+copy(hztmp,4*i-1,2);
end
end;
have0:=0;{如果个（元）位、万位、亿位、兆位为0,处理后将HAVE0置0}
end
else
if have0=1 then
hzstr:=hzstr+hz0;{遇第一个0则读出}
end{1}
{if szstr<>'0'} else
begin
{遇非0数字则读出该位并将HAVE0置0}
hzstr:=hzstr+copy(hztmp,4*i-3,4);
have0:=0;
end;

end{for};
result:=hzstr+m2w;{返回值=整数位+小数位}
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)do
wnto 1do
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 > 0do
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 lxdo
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);

function GetRMBChar(Value : Char;
Level : Integer) : String;
var
S : String;
begin
case Value of
'0': S := '零';
'1': S := '壹';
'2': S := '贰';
'3': S := '叁';
'4': S := '肆';
'5': S := '伍';
'6': S := '陆';
'7': S := '柒';
'8': S := '捌';
'9': S := '玖';
end;
case Level of
0: S := S + '分';
1: S := S + '角';
2: S := S + '元';
3: S := S + '拾';
4: S := S + '佰';
5: S := S + '仟';
6: S := S + '萬';
7: S := S + '拾';
8: S := S + '佰';
9: S := S + '仟';
10: S := S + '億';
end;
Result := S;
end;

function ChangeToRMB(Value : String) : String;
var
I : Integer;
S : String;
begin
S := ';
for I := Length(Value)do
wnto 1do
S := GetRMBChar(Value, Length(Value) - I) + S;
Result := S;
end;

function GetRMBString(Value : Float) : String;
var
S1, s2 : String;
begin
S1 := FormatCurr('#.00', Value);
Delete(S1, Pos('.', S1), 1);
S2 := ChangeToRMB(S1);
S1 := FormatCurr(',#.00', Value );
S2 := S2 + '整(RMB:' + S1 + ')';
Result := S2
end;

function MoneyName(Value:do
uble): string;
const
SCnNumber = '零壹贰叁肆伍陆柒捌玖';
SCnPower = '拾佰仟';
var
V, V1:do
uble;
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 4do
if X <> 0 then
begin
BL := False;
Break;
end;
if BL then
Result := '零元整'
else
begin
//先计算整数部分每节的串
for I := 0 to 3do
begin
S := '';
if X > 0 then
begin
B := False;
P := 1000;
BK := False;
//前位为零
BL := False;
//未记录过
for J := 0 to 3do
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 3do
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;

自已搜索一下以前的贴子，很多这种函数的。

function Tform1.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)do
wnto 1do
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;

使用:
var
sBig : widestring;
begin
sBig := SmallTOBig(50000.4234);
//得到大写的金额
showmessage(sBig);
...
end;

我搜索了我以前下载的dephibbs的文章，发现了有针对的文章。也谢谢大家的关心

我搜索了我以前下载的dephibbs的文章，发现了有针对的文章。也谢谢大家的关心

我在使用的函数
RMBDesc: array [1..20] Of string = ('分','角','元','十','百','千','万','十','百',
'千','亿','十','百','千','万','十','百','千','亿','十');
RMBNumb: array [0..9] Of string = ('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
Function RMB(Const ValuesaramValue):Variant;
var i : Int64;
j,k:byte;
s:string;
have0:Boolean;
x:real;
begin
x := Values.Values[0];
i := round(x*100);
s := intToStr(i);
k := Length(s);
j := 1;
have0 := False;
Result := '';
if (s[1]='1') and (k in [4,8,12,16,20]) then
else
Result := RMBNumb[Ord(s[1])-48];
Result := Result + RMBDesc[k];
dec(k);
for j := 2 To Length(s)do
begin
if (s[j]='0') then
begin
have0 := true;
if (k in [3,7,11,15,19])then
begin
if (k in [7,15])and(Length(s)> k + 4)and(copy(s,Length(s)-k-3,4)='0000') then
else
Result := Result + RMBDesc[k];
have0 := False;
End
else
if (k<=2) then
Have0 := False;
End
else
begin
if have0 then
Result := Result + RMBNumb[0];
Result := Result + RMBNumb[ord(s[j])-ord('0')];
Result := Result + RMBDesc[k];
Have0 := False;
end;
dec(k);
end;
end;

看這個：
Function Changle(str:string):string;
Var Math1,unit1,math2:string;
i,count,j:integer;
mat1,mat2,mat3:string;
result1,result2,result3:string;
begin
Try
if str='' then
result:=''
else
begin
mat1:=Formatfloat('0.000',strtofloat(str));
result1:='';
for i:=length(mat1)do
wnto 1do
begin
if mat1<>'.' then
begin
case mat1 of
'0':math1:='零';
'1':math1:='一';
'2':math1:='二';
'3':math1:='三';
'4':math1:='四';
'5':math1:='五';
'6':math1:='六';
'7':math1:='七';
'8':math1:='八';
'9':math1:='九';
end;

j:=length(mat1)-i+1;
case j of
1:unit1:='厘';
2:unit1:='分';
3:unit1:='角';
5:unit1:='元';
6:unit1:='十';
7:unit1:='百';
8:unit1:='千';
9:unit1:='萬';
10:unit1:='十';
11:unit1:='百';
12:unit1:='千';
13:unit1:='億';
14:unit1:='十';
15:unit1:='百';
16:unit1:='千';
17:unit1:='萬';
end;

result1:=math1+unit1+result1;
end;
end;
//元，萬，億前為零，將零刪除掉
//零后的除元，萬，億外的單位，將單位刪除掉
//不能連續出現兩個零
mat2:='元萬億';

while pos('零厘',result1)>0do
delete(result1,pos('零厘',result1)+2,2);
while pos('零分',result1)>0do
delete(result1,pos('零分',result1)+2,2);
while pos('零角',result1)>0do
delete(result1,pos('零角',result1)+2,2);
while pos('零十',result1)>0do
delete(result1,pos('零十',result1)+2,2);
while pos('零百',result1)>0do
delete(result1,pos('零百',result1)+2,2);
while pos('零千',result1)>0do
delete(result1,pos('零千',result1)+2,2);
while pos('零零',result1)>0do
delete(result1,pos('零零',result1)+2,2);
while pos('零元',result1)>0do
delete(result1,pos('零元',result1),2);
while pos('零萬',result1)>0do
delete(result1,pos('零萬',result1),2);
while pos('零億',result1)>0do
delete(result1,pos('零億',result1),2);
if copy(result1,1,4)='一十' then
delete(result1,1,2);
while pos('億萬',result1)>0do
delete(result1,pos('億萬',result1)+2,2);
if copy(result1,length(result1)-1,2)='零' then
delete(result1,length(result1)-1,2);
result:=result1;
end;

Except
showmessage('格式錯誤!');
abort;
end;

end;

天哪，差不多的东西贴了这么多遍，大家累不累啊。

begin
TestStream := TMemoryStream.Create;
try
with AQuerydo
begin
TBlobField(FieldByName(sFieldName)).SaveToStream(TestStream);
TestStream.Seek(0, soFrombegin
ning);
TestStream.Read(CurData, SizeOf(CurData));
end;
finally
TestStream.Free;
end;
end;

这么多～

我的是vfp的，
a=int(je)
b=je-a
ss=''
dime dx(10)
dime dw(4)
dime dq(3)
dx(10)='玖'
dx(9)='捌'
dx(8)='柒'
dx(7)='陆'
dx(6)='伍'
dx(5)='肆'
dx(4)='叁'
dx(3)='贰'
dx(2)='壹'
dx(1)='零'
i=1
dw(1)='仟'
dw(2)=''
dw(3)='十'
dw(4)='佰'
ll=.f.
dq(1)=''
dq(2)='万'
dq(3)='亿'
do while a>0
sa=''
c=mod(a,10)

if c>0
sa=dx(c+1)+dw(mod(i,4)+1)
ll=.t.
else

if ll=.t.
ll=.f.
if mod(i,4)<>1
sa=dx(1)
endif
endif
endif

if mod(i-1,8)=0 .and. i>1
sa=sa+dq(3)
else
if mod (i-1,4)=0 .and. i>1 .and. (mod(a,10000)<>0)
sa=sa+dq(2)
endif
endif
ss=sa+ss
i=i+1
a=int(a/10)
enddo
ss=ss+'元'
b=b*10
d=int(b)
b=b-d
e=int(b*10)
if d>0
ss=ss+dx(d+1)+'角'
endif
if e>0
ss=ss+dx(e+1)+'分'
endif
return ss

以下函數可實現小轉大.
function smalltobig(money: real): string;
var
smoney,szero: string;
sint,sdig,ssint,ssdig: string;
pdig,i,n: integer;
hz: array[1..16] of string;
sz: array[1..10] of string;
pp,dd: boolean;
begin
pp:=false;
dd:=false;
//------------
hz[1]:='元';
hz[2]:='拾';
hz[3]:='佰';
hz[4]:='仟';
hz[5]:='萬';
hz[6]:='拾';
hz[7]:='佰';
hz[8]:='仟';
hz[9]:='億';
hz[10]:='拾';
hz[11]:='佰';
hz[12]:='仟';
hz[13]:='萬';
hz[14]:='拾';
hz[15]:='佰';
hz[16]:='仟';
//-----------
sz[10]:='零';
sz[1]:='壹';
sz[2]:='貳';
sz[3]:='參';
sz[4]:='肆';
sz[5]:='伍';
sz[6]:='陸';
sz[7]:='柒';
sz[8]:='捌';
sz[9]:='玖';
//----------
//--把數字轉成字符--
smoney:=floattostr(money);
//--判斷小數點位--
pdig:=pos('.',smoney);
if pdig>0 then
begin
sint:=copy(smoney,1,pdig-1);
sdig:=copy(smoney,pdig+1,2);
if copy(smoney,pdig-1,1)='0' then
szero:='零'
else
szero:='';
end
else
begin
sint:=smoney;
sdig:='';
end;
//-----------------------
for i:=1 to length(sint)do
begin
if copy(sint,length(sint)-i+1,1)<>'0' then
begin
ssint:=sz[strtoint(copy(sint,length(sint)-i+1,1))]+hz+ssint;
pp:=true;
end
else
begin
if pp and (copy(ssint,1,2)<>sz[10]) then
begin
ssint:=sz[10]+ssint;
pp:=false;
end;
//--------------------------
if i=5 then
begin
for n:=5 to 9do
begin
if copy(sint,length(sint)-n+1,1)<>'0' then
dd:=true;
end;
if dd then
ssint:=hz+ssint;
end;
//-----------------------------
if (i=13) or (i=9) then
ssint:=hz+ssint;
end;
end;
//--小數--
if sdig<>'' then
begin
if copy(sdig,1,1)<>'0' then
ssdig:=sz[strtoint(copy(sdig,1,1))]+'角';
if length(sdig)>=2 then
if copy(sdig,2,1)<>'0' then
ssdig:=ssdig+sz[strtoint(copy(sdig,2,1))]+'分';
end
else
ssdig:='';
//-----------------
result:=ssint+szero+ssdig;
end;

多人接受答案了。