- 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;
Function CovMoney(money : Double) : String; //小写金额转换成大写金额
Var
sStr, buf, sPower, buf1 : String;
i, j, iPosition, lenth, iTmp : Integer;
flag0 : boolean;
Function Sjoin(Var buff : String; sString : String; digit : String; nextdig : String; iPos : Integer) : Integer;
Var
dig : String; // * 1
flag0 : Boolean;
Begin
flag0 := True;
If digit = '0' Then
If nextdig <> '0' Then
dig := '零'
Else
flag0 := False;
If digit = '1' Then
dig := '壹';
If digit = '2' Then
dig := '贰';
If digit = '3' Then
dig := '叁';
If digit = '4' Then
dig := '肆';
If digit = '5' Then
dig := '伍';
If digit = '6' Then
dig := '陆';
If digit = '7' Then
dig := '柒';
If digit = '8' Then
dig := '捌';
If digit = '9' Then
dig := '玖';
If digit = '0' Then
If (flag0 = True) And (iPos <> 0) Then
Begin
buff := buff + dig;
Result := 2;
End
Else
Result := 0
Else
Begin
buff := buff + dig;
buff := buff + sString;
Result := 4;
End;
End;
Begin
If money = 0 Then
Begin
Result := '零元整';
exit;
End;
iPosition := 0;
buf1 := trim(Format('%12.2f', [money]));
lenth := Length(buf1);
buf := ' '; // 16 bit space;
j := 1;
For i := 16 - lenth To 15 Do
Begin
buf[i] := buf1[j];
j := j + 1;
End;
For i := 1 To 15 Do
Begin
iTmp := ord(buf[i]);
If ((iTmp >= 49) And (iTmp <= 58)) Or (chr(iTmp) = ',') Then
break;
End;
While i <= 15 Do
Begin
flag0 := True;
iTmp := 0;
Case i - 1 Of
0, 4, 8 : sPower := '仟';
1, 5, 9 : sPower := '佰';
2, 6, 10 : sPower := '拾';
3 :
Begin
sPower := '亿';
If copy(buf, i, 1) = '0' Then
Begin
sStr := sStr + sPower+'零';
iPosition := iPosition + 2;
iTmp := 1;
End;
End;
7 :
Begin
sPower := '万';
If copy(buf, i, 1) = '0' Then
Begin
sStr := sStr + sPower+'零';
iPosition := iPosition + 2;
iTmp := 1;
End;
End;
11 :
Begin
sPower := '元';
If (copy(buf, i, 1) = '0') And (iPosition <> 0) Then
Begin
sStr := sStr + sPower;
iPosition := iPosition + 2;
iTmp := 1;
End;
End;
12 :
Begin
flag0 := False;
If (copy(buf, i + 1, 1) = '0') And (copy(buf, i + 2, 1) = '0') Then
Begin
sPower := '整';
sStr := sStr + sPower;
iPosition := iPosition + 2;
iTmp := 2;
End;
End;
13 : sPower := '角';
14 :
Begin
If copy(buf, i, 1) = '0' Then iTmp := 2;
sPower := '分';
End;
End;
If (flag0 = True) And (iTmp = 0) Then
Begin
If i > 0 Then
iPosition := iPosition + Sjoin(sStr, sPower, copy(buf, i, 1), copy(buf, i + 1, 1), iPosition)
Else
iPosition := iPosition + Sjoin(sStr, sPower, copy(buf, i, 1), copy(buf, i, 1), iPosition);
End;
If iTmp = 2 Then
break
Else
i := i + 1;
End;
// If (ilength <> 0) Then ilength := iPosition;
If pos('整', sStr) < 1 then
begin
if (pos('角', sStr) < 1) and (pos('分', sStr) < 1) Then
sStr := sStr + '整';
end;
sStr :=stringreplace(sStr,'零零','零',[rfReplaceAll]);
sStr :=stringreplace(sStr,'零元','元',[rfReplaceAll]);
Result := Trim(sStr);
End;