求将数字金额转化为中文金额的函数?

解决方案 »

  1.   

    金额大小写转换
    function My_StrToRMB(curs :string) :string;
    implementationfunction  My_StrToRMB(curs: string) :string ;
    var
      daxie,danwei,minuscurs:string;
      i,j,deccount :integer ;
      rmb :int64;begin
      curs:=trim(curs);
      if (curs='-') or (curs='.') or (curs='') then  // '.','-',''错
      begin
        result:='ERROR';
        exit;
      end;
      deccount :=0;
      for i:=1 to length(curs) do
      begin
        if  not (curs[i]  in ['0'..'9','.','-']) then     //'123w2'错
        begin
          result:='ERROR';
          exit;
        end;
        if (curs[i]='.') and (deccount>0) then  //'12313.324.23'错
        begin
          result:='ERROR';
          exit;
        end;
        if (curs[i]='-') and (i>1) then        //'-123-123'错
        begin
          result:='ERROR';
          exit;
        end;
        if curs[i]='.' then  inc(deccount);
      end;
      rmb:=round(StrToFloat(curs)*100);
      minuscurs:='';  //负数标志
      if rmb<0 then
      begin
        minuscurs:='(负数)' ;
        rmb:=(-1)*rmb;
      end;
      if rmb>=1E18 then     //超过9千万亿
      begin
        result:='ERROR';
        exit;
      end;
      curs:='';
      i:=0; j:=0 ;
      while rmb>0 do
      begin
        j:= rmb mod 10;
        case j of
          0 : daxie :='零' ;
          1 : daxie :='壹' ;
          2 : daxie :='贰' ;
          3 : daxie :='叁' ;
          4 : daxie :='肆' ;
          5 : daxie :='伍' ;
          6 : daxie :='陆' ;
          7 : daxie :='柒' ;
          8 : daxie :='捌' ;
          9 : daxie :='玖' ;
        end;
        case i of
          0 : danwei :='分' ;
          1 : danwei :='角' ;
          2 : danwei :='圆' ;
          3 : danwei :='拾' ;
          4 : danwei :='佰' ;
          5 : danwei :='仟' ;
          6 : danwei :='万' ;
          7 : danwei :='拾' ;
          8 : danwei :='佰' ;
          9 : danwei :='仟' ;
          10 : danwei :='亿' ;
          11 : danwei :='拾' ;
          12 : danwei :='佰' ;
          13 : danwei :='仟' ;
          14 : danwei :='万' ;
          15 : danwei :='拾' ;
          16 : danwei :='佰' ;
          17 : danwei :='仟' ;
        end;
        rmb:=rmb div 10;
        if j<>0 then curs:=daxie+danwei+curs;      //该位上不为0
        if (j=0) and (not (i in [2,6,10,14])) then //该位为0,是一般位
            curs:=daxie+curs;
        if (j=0) and  (i in [2,6,10,14]) then      //该位为0,是敏感位
            curs:=danwei+curs;
        inc(i);
      end;
      while pos('零零',curs)>0  do  curs:=stringreplace(curs,'零零','零',[]);
      curs:=stringreplace(curs,'零圆','圆',[]);
      while pos('零万',curs)>0  do curs:=stringreplace(curs,'零万','万',[]); //上万亿后可能两个'零万'
      curs:=stringreplace(curs,'零亿','亿',[]);
      curs:=stringreplace(curs,'角零','角整',[]);
      if copy(curs,length(curs)-3,4)='圆零' then  //最后两位是圆零.
          curs:=stringreplace(curs,'圆零','圆整',[]);  //小数点后
      curs:=stringreplace(curs,'亿万','亿',[]);
      result:=minuscurs+curs;
    end;
      

  2.   

    Function MaxtoMin(minje:string):string;
    var
      dx,dy,nn,cccc,dd,c,cc,lc:string;
      n,iii:integer;
    begin
      dx:='壹贰叁肆伍陆柒捌玖';
      dy:='分角圆拾佰仟万拾佰仟亿拾佰';
      nn:=trim(floattostr(strtofloat(minje)*100));
      n:=length(nn);
      cccc:='整';
      for iii:=1 to n do
      begin
        dd:=copy(dy,iii*2-1,2);
        c:=copy(nn,n-iii+1,1);
        if c<>'0' then
        begin
          cc:=copy(dx,(strtoint(c)*2 - 1),2);
          cccc:=trim(cc)+trim(dd)+trim(cccc);
        end
        else
        begin
          lc:=copy(trim(cccc),1,2);
          if ((iii=3) or (iii=7) or (iii=11)) then
          begin
            cccc:=trim(dd) + trim(cccc);
            continue;
          end;
          if ((lc<>'零') and (LC<>'整') and (LC<>'亿') and (LC<>'万') and (LC<>'圆')) then
            cccc:='零'+cccc;
        end;
      end;
      cccc:='合计:'+cccc;
      Result:=cccc;end;
    //调用:
    showmessage(MaxtoMin(trim('100')));
      

  3.   

    function ToBigRMB(RMB: string): string;
    const
      BigNumber='零壹贰叁肆伍陆柒捌玖';
      BigUnit='万仟佰拾亿仟佰拾万仟佰拾元';  {共可表示13位金额}
    var
      nLeft, nRight, lTemp, rTemp, BigNumber1, BigUnit1: string;
      I: Integer;
    begin
      RMB:=FormatCurr('0.00', StrToFloat(RMB));//确保数字小数后有两位数字
      {取整数和小数部分}
      nLeft:=copy(RMB, 1, Pos('.', RMB) - 1);
      nRight:=copy(RMB, Pos('.', RMB) + 1, 2);
      {转换整数部分}
      for I:=1 to Length(nLeft) do
      begin
        BigNumber1:=copy(BigNumber, StrToInt(nLeft[I]) * 2 + 1, 2);
        BigUnit1:=copy(BigUnit, (Trunc(Length(BigUnit) / 2) - Length(nleft) + I - 1) * 2 + 1, 2);
        if (BigNumber1='零') and ((copy(lTemp, Length(lTemp)- 1, 2))='零')then
          lTemp:=copy(lTemp, 1, Length(lTemp) - 2);
        if (BigNumber1='零') and ((BigUnit1='亿') or (BigUnit1='万') or (BigUnit1='元')) then
        begin
          BigNumber1:=BigUnit1;
          if BigUnit1<>'元' then  BigUnit1:='零'  else  BigUnit1:='';
        end;
        if (BigNumber1='零') and (BigUnit1<>'亿') and (BigUnit1<>'万') and (BigUnit1<>'元') then BigUnit1:='';
        lTemp:=lTemp + BigNumber1 + BigUnit1;
      end;
      if Pos('亿万', lTemp)<>0 then Delete(lTemp, Pos('亿万', lTemp) + 2, 2);
      {转换小数部分}
      if StrToInt(nRight[1])<>0 then
         rTemp:=copy(BigNumber, StrToInt(nRight[1]) * 2 + 1, 2) + '角';
      if StrToInt(nRight[2])<>0 then
      begin
        if StrToInt(nRight[1])=0 then  rTemp:='零';
        rTemp:=rTemp + copy(BigNumber, StrToInt(nRight[2]) * 2 + 1, 2) + '分';
      end;
      Result:=lTemp + rTemp ;
      if lTemp = '元' then Result := rTemp ;
      if length(rTemp) = 0 then result := lTemp + '整';
    end;
      

  4.   

    前段时间刚用的,在别人的基础上改了一点点小BUG
      

  5.   

    一段最简单的代码:function xTOD(str:String):string;
    var
      dStr1,dStr2:string;
      Ts1,Ts2:string;
      Tc:char;
      v1,i:integer;
    begin
      dStr1:='零壹贰叁肆伍陆柒捌玖';
      dStr2:='万仟佰拾元角分';
      Ts1:=str;
      Delete(Ts1,Pos('.',Ts1),1);
      Ts2:='';
      for i:=1 to length(Ts1) do
        Ts2:=Ts2+Copy(dStr1,(StrToInt(Copy(Ts1,i,1)))*2+1,2)+Copy(dStr2,15-((Length(Ts1)-i+1)*2),2);
      xToD:=Ts2;
    end;
      

  6.   

    function xTOd(i:double):string;
    const
      d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
    var
      m,k:string;
      j:integer;
    begin
      k:='';
      m:=floattostr(int(i*100));
      for j:=length(m) downto 1 do
        k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2];
      xTOd:=k;
    end;我在网上也找了段最短的,不过输入10000000试试就比较失望了,后面还得加点处理
      

  7.   

    我这里也收藏有一个.验证过的.function NumberToString(ls: Variant): string;
    var
      dx_sz, dx_dw, str_int, str_dec, dx_str, fu: string;
      a, b, b2, c, d: string;
      num_int, num_dec, len_int, i, a_int, pp: integer;
    begin
      dx_sz := '零壹贰叁肆伍陆柒捌玖';
      dx_dw := '万仟佰拾亿仟佰拾万仟佰拾元';
      //处理金额小于零情况
      if ls < 0 then
      begin
        ls := ls * (-1);
        fu := '负';
      end
      else
        fu := '';
        
      //取得整数值及整数串
      dx_str := ls;
      if (ls > 0) and (ls < 1) then dx_str := '0' + dx_str;
      pp := pos('.', dx_str);  if pp > 0 then
        str_int := copy(dx_str, 1, pos('.', dx_str) - 1)
      else
        str_int := dx_str;  num_int := strtoint(str_int);
    //取得小数值及小数串  if (ls > 0) and (ls < 1) then    num_dec := ls * 100  else    num_dec := (ls - num_int) * 100;  str_dec := inttostr(num_dec);  len_int := Length(str_int);  dx_str := '';//转换整数部分  for i := 1 to len_int do    begin//a为小写数字字符,b为对应的大写字符//c为对应大写单位,d为当前大写字符串的最后一个汉字      a := copy(str_int, i, 1);      a_int := strtoint(a);      b := copy(dx_sz, (a_int * 2 + 1), 2);      c := copy(dx_dw, ((13 - len_int + i - 1) * 2 + 1), 2);      if dx_str <> '' then        d := copy(dx_str, Length(dx_str) - 1, 2)      else        d := '';      if (b = '零') and ((d = '零') or (b = b2) or (c = '元') or (c = '万') or (c = '亿')) then b := '';      if (a = '0') and (c <> '元') and (c <> '万') and (c <> '亿') then c := '';      if ((c = '元') or (c = '万') or (c = '亿')) and (d = '零') and (a = '0') then        begin          dx_str := copy(dx_str, 1, Length(dx_str) - 2);          d := copy(dx_str, Length(dx_str) - 1, 2);          if ((c = '元') and (d = '万')) or ((c = '万') and (d = '亿')) then c := '';        end;      dx_str := dx_str + b + c;      b2 := b;    end;//处理金额小于1的情况  if Length(dx_str) <= 2 then dx_str := '';//转换小数部分  if (num_dec < 10) and (ls > 0) then    begin      a_int := strtoint(str_dec);      b := copy(dx_sz, (a_int * 2 + 1), 2);      if num_dec = 0 then dx_str := dx_str + '整';      if num_dec > 0 then dx_str := dx_str + '零' + b + '分';    end;  if num_dec >= 10 then    begin      a_int := strtoint(copy(str_dec, 1, 1));      a := copy(dx_sz, (a_int * 2 + 1), 2);      a_int := strtoint(copy(str_dec, 2, 1));      b := copy(dx_sz, (a_int * 2 + 1), 2);      if a <> '零' then a := a + '角';      if b <> '零' then        b := b + '分'      else        b := '';      dx_str := dx_str + a + b;    end;  if ls = 0 then dx_str := '零元整';  dx_str := fu + dx_str;//函数返回字符串  Result := dx_str;end;