大写金额
写合同需要把金额转换成大写,找了一些,都有些错。
谁有比较完美的?
[解决办法]
function NumToRmb(const S:WideString):WideString;//[====防止出现000001的情况 procedure DeleZero(var S:WideString); begin if s[1]='0' then begin Delete(s,1,1); if Length(s)>1 then DeleZero(s); //递归 end; end;//=======]const ARmbUnits:WideString='仟佰拾万仟佰拾亿仟佰拾万仟佰拾元元角分厘'; AUpper:WideString='零壹贰叁肆伍陆柒捌玖'; AYuanPos=16; AKeyWordPos=[4,8,12,16]; //万亿万元的位置var dotPos,Len,nUnitLen:integer; Amount,RMB,sNum,sUnit:WideString; i,n,k:integer;begin Amount:=Trim(S); try DeleZero(Amount); //调用内部过程 len:=Length(Amount); dotPos:=pos('.',Amount); //小数点的位置 //===[判断数字长度有否越界 if dotPos>0 then begin if dotPos>AYuanPos+1 then begin ShowMessage('数值超过千亿位'); Exit; end else nUnitLen:=AYuanPos-dotPos+1; //对齐元 end else begin if Len>AYuanPos then begin ShowMessage('数值超过千亿位'); Exit; end else nUnitLen:=AYuanPos-Len; //对齐元 end; //======] RMB:='';// if dotPos>0 then// nUnitLen:=AYuanPos-dotPos+1 //对齐元// else nUnitLen:=AYuanPos-Len; i:=1; while i<=Len do begin if i=dotPos then inc(i); //碰到小数点挪到下位 n:=nUnitLen+i; //计算金额单位的位置 k:=strtoint(Amount[i]); sNum:=AUpper[k+1]; //数字数值 sUnit:=ARmbUnits[n]; //单位 if k=0 then //为零的大写习惯 begin if i<Len then begin if i+1<>dotPos then begin k:=strtoint(Amount[i+1]); if (k=0) or (n in AKeyWordPos) then sNum:=''; end else sNum:=''; end else sNum:=''; if not(n in AKeyWordPos) or (dotPos=2) then sUnit:=''; end; RMB:=RMB+sNum+sUnit; inc(i); end; if Pos('零',RMB)=1 then Delete(RMB,1,1);//解决0.09类的问题 k:=Pos('亿万',RMB); //解决亿万问题 if k>0 then Delete(RMB,k+1,1); if RMB[1]='元' then Result::= o
[解决办法]
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]); 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) 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^ts, 2);