首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > .NET >

大写金额,该如何处理

2012-05-04 
大写金额写合同需要把金额转换成大写,找了一些,都有些错。谁有比较完美的?[解决办法]Delphi(Pascal) codefu

大写金额
写合同需要把金额转换成大写,找了一些,都有些错。

谁有比较完美的?

[解决办法]

Delphi(Pascal) code
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
[解决办法]
Delphi(Pascal) code
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); 

热点排行