uses
math;
const mnUnit:WideString ='分角元';
const OtherWords:WideString='整负';
const hzUnit:WideString = '拾佰仟万拾佰仟亿';
const hzNum:WideString='零壹贰叁肆伍陆柒捌玖';
function Money2ChineseCapital2(const Num:double ): WideString;
var
szNum:PWideChar;
i,iLen,iLen2, iNum, iAddZero,ResultCount:Integer;
buff:AnsiString;
buf:PAnsiChar;
dblNum: Double;
begin
SetLength(Result,33*2 + 1);
iAddZero := 0;
if Num < 0.0 then
dblNum := Num * 100.0 + 0.5
else
dblNum := Num * 100.0 - 0.5;
buff := format('%0.0f',[dblNum]);
if Pos(buff,'e')>0 then begin
SetLength(Result,0);
Raise Exception.Create('数值过大!');
Exit;
end;
iLen := Length(buff);
szNum := PWideChar(Result);
buf := PAnsiChar(buff);
if(Num<0.0) then
begin
szNum^:=OtherWords[2];
Inc(szNum);
Inc(buf);
Dec(iLen);
end;
for i:=1 to iLen do
begin
iNum :=Ord(buf^)-48;
Inc(buf);
iLen2 := iLen-i;
if(iNum=0) then
begin
if(((iLen2-2) mod 4)=0) and ((iLen2-3)>0) and (((iLen2>=8) or (iAddZero<3))) then
begin
szNum^ := hzUnit[(iLen2-3) mod 8 + 1];
Inc(szNum);
end;
Inc(iAddZero);
if(iLen>1) and (iLen2=1) and (buff[iLen] <> '0') then
begin
szNum^:=hzNum[1];
Inc(szNum);
end;
end
else
begin
if(((iAddZero>0) and (iLen2>=2)) and (((iLen2-1) mod 4)<>0) or ((iAddZero>=4) and ((iLen2-1)>0))) then
begin
szNum^:=hzNum[1];
Inc(szNum);
end;
szNum^:=hzNum[iNum+1];
Inc(szNum);
iAddZero:=0;
end;
if (iAddZero<1) or (iLen2=2) then
begin
if(iLen-i>=3) then
begin
szNum^:=hzUnit[(iLen2-3) mod 8 + 1];
Inc(szNum);
end
else
begin
szNum^:=mnUnit[(iLen2) mod 3 +1 ];
Inc(szNum);
end;
end;
end;
ResultCount := szNum-PWideChar(Result);
if((Num < 0.0) and (ResultCount - 1 = 0)) or ((Num>=0.0) and (ResultCount=0)) then
begin
szNum^:=hzNum[1];
Inc(szNum);
szNum^:=mnUnit[3];
Inc(szNum);
szNum^:=OtherWords[1];
Inc(szNum);
Inc(ResultCount,3);
end
else
if((Num<0.0) and (buff[iLen+1] ='0')) or ((Num>=0.0) and (buff[iLen] ='0')) then
begin
szNum^:=OtherWords[1];
Inc(ResultCount);
end;
SetLength(Result, ResultCount);
end;
