Function TForm33.CurrToCharNum(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
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;
