我想做一个大小写的函数意思是:1738,5
壹千柒佰叁拾捌元伍角中间的零需要处理

解决方案 »

  1.   

    做呀,遇到什么问题了吗?
    有问题请发信息到我的E-mail:[email protected]
      

  2.   

    转贴如下为一个简单的小写金额转换为大写的函数,其思路简单(可以说烂吧,居然利用了位置来转换),但是它几乎可以无限制的转换,只要你能读得出来和写得进去:
    function Tform1.SmallTOBig(small:real):string;
    var SmallMonth,BigMonth:string;
    wei1,qianwei1:string[2];
    wei,qianwei,dianweizhi,qian:integer;
    begin
    {------- 修改参数令值更精确 -------}
    {小数点后的位置,需要的话也可以改动-2值}
    qianwei:=-2;
    {转换成货币形式,需要的话小数点后加多几个零}
    Smallmonth:=formatfloat('0.00',small);
    {---------------------------------}
    dianweizhi :=pos('.',Smallmonth);{小数点的位置}
    {循环小写货币的每一位,从小写的右边位置到左边}
    for qian:=length(Smallmonth) downto 1 do
    begin
    {如果读到的不是小数点就继续}
    if qian<>dianweizhi then
    begin
    {位置上的数转换成大写}
    case strtoint(copy(Smallmonth,qian,1)) of
    1:wei1:='壹'; 2:wei1:='贰';
    3:wei1:='叁'; 4:wei1:='肆';
    5:wei1:='伍'; 6:wei1:='陆';
    7:wei1:='柒'; 8:wei1:='捌';
    9:wei1:='玖'; 0:wei1:='零';
    end;
    {判断大写位置,可以继续增大到real类型的最大值}
    case qianwei of
    -3:qianwei1:='厘';
    -2:qianwei1:='分';
    -1:qianwei1:='角';
    0 :qianwei1:='元';
    1 :qianwei1:='拾';
    2 :qianwei1:='佰';
    3 :qianwei1:='千';
    4 :qianwei1:='万';
    5 :qianwei1:='拾';
    6 :qianwei1:='佰';
    7 :qianwei1:='千';
    8 :qianwei1:='亿';
    9 :qianwei1:='十';
    10:qianwei1:='佰';
    11:qianwei1:='千';
    end;
    inc(qianwei);
    BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
    end;
    end;
    SmallTOBig:=BigMonth;
    end;
    调用如下“edit1.text:=SmallTOBig(1234567890.1234);”他自动默认小数点后两位
    我已经用过,好用,
      

  3.   

    i:integer;j:=1;
    resultstr:string;
    for i:=length(str) to 1  do
    begin
    case i- pos(',',str) of
    1:resultstr:='角'+resultstr;
    2:resultstr:='分'+resultstr;
    -1:resultstr:='元'+resultstr;
    -2:resultstr:='拾'+resultstr;
    -3:resultstr:='佰'+resultstr;
    ...
    -9:resultstr:='拾億'+resultstr;
    end;case copy(str,i,1) of
    0:if copy(resultstr,1,1)<>'零' then resultstr:='零'+resultstr;
    1:resultstr:='壹'+resultstr;
    2:resultstr:='贰'+resultstr; 
    ...
    9:resultstr:='玖'+resultstr;
    end;
    end;
      

  4.   

    myling(阿德) 你的函数是很好用,但出现100.45这种情况时读出就不对了,你试试看
      

  5.   

    下面的单元文件包含了数字和中文互相转化的两个函数,写得很漂亮,可以解决一切问题。首先向作者表示感谢!//代码来自32位深度历险台湾钱达智先生unit cutils;interfaceuses
        SysUtils;function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
    function Num2CNum(dblArabic: double): string;implementation(* -------------------------------------------------- *)
    (* Num2CNum  将阿拉伯数字转成中文数字字串
    (* 使用示例:
    (*  Num2CNum(10002.34) ==> 一万零二点三四
    (*
    (* Author: Wolfgang Chien 
    (* Date: 1996/08/04
    (* Update Date:
    (* -------------------------------------------------- *)
    function Num2CNum(dblArabic: double): string;
    const
      _ChineseNumeric = '零一二三四五六七八九';
    var
      sArabic: string;
      sIntArabic: string;
      iPosOfDecimalPoint: integer;
      i: integer;
      iDigit: integer;
      iSection: integer;
      sSectionArabic: string;
      sSection: string;
      bInZero: boolean;
      bMinus: boolean;  (* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
      function ConvertStr(const sBeConvert: string): string;
      var
        x: integer;
      begin
        Result := '';
        for x := Length(sBeConvert) downto 1 do
          AppendStr(Result, sBeConvert[x]);
      end; { of ConvertStr }
    begin
      Result := '';
      bInZero := True;
      sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
      {$ifdef __Debug}
      ShowMessage('FloatToStr(dblArabic): ' + sArabic);
      {$endif}
      if sArabic[1] = '-' then
      begin
        bMinus := True;
        sArabic := Copy(sArabic, 2, 254);
      end
      else
        bMinus := False;
      iPosOfDecimalPoint := Pos('.', sArabic);  (* 取得小数点的位置 *)
      {$ifdef __Debug}
      ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
      {$endif}  (* 先处理整数的部分 *)
      if iPosOfDecimalPoint = 0 then
        sIntArabic := ConvertStr(sArabic)
      else
        sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
      (* 从个位数起以每四位数为一小节 *)
      for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
      begin
        sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
        sSection := '';
        (* 以下的 i 控制: 个十百千位四个位数 *)
        for i := 1 to Length(sSectionArabic) do
        begin
          iDigit := Ord(sSectionArabic[i]) - 48;
          if iDigit = 0 then
          begin
            (* 1. 避免 '零' 的重覆出现 *)
            (* 2. 个位数的 0 不必转成 '零' *)
            if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
            bInZero := True;
          end
          else
          begin
            case i of
              2: sSection := '十' + sSection;
              3: sSection := '百' + sSection;
              4: sSection := '千' + sSection;
            end;
            sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
              sSection;
            bInZero := False;
          end;
        end;    (* 加上该小节的位数 *)
        if Length(sSection) = 0 then
        begin
          if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
            Result := '零' + Result;
        end
        else
        begin
          case iSection of
            0: Result := sSection;
            1: Result := sSection + '万' + Result;
            2: Result := sSection + '亿' + Result;
            3: Result := sSection + '兆' + Result;
          end;
        end;
        {$ifdef __Debug}
        ShowMessage('sSection: ' + sSection);
        ShowMessage('Result: ' + Result);
        {$endif}
      end;  (* 处理小数点右边的部分 *)
      if iPosOfDecimalPoint > 0 then
      begin
        AppendStr(Result, '点');
        for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
        begin
          iDigit := Ord(sArabic[i]) - 48;
          AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
        end;
      end;  {$ifdef __Debug}
      ShowMessage('Result before 其他例外处理: ' + Result);
      {$endif}
      (* 其他例外状况的处理 *)
      if Length(Result) = 0 then Result := '零';
      if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
      if Copy(Result, 1, 2) = '点' then Result := '零' + Result;  (* 是否为负数 *)
      if bMinus then Result := '负' + Result;
      {$ifdef __Debug}
      ShowMessage('Result before Exit: ' + Result);
      {$endif}
    end;
    (* -------------------------------------------------- *)
    (* CNum2Num  将中文数字字串转成阿拉伯数字
    (* 使用示例:
    (*  if CNum2Num('一千三百万零四十点一零三', dblTest)
    (*    dblTest ==> 13000040.103
    (*
    (* 注意事项:
    (*  1. 转换成功, 函数传回 True; 否则为 False
    (*  2. 不支援 '四万万' 等的说法, 必须为标准的记数方式
    (*
    (* Author: Wolfgang Chien 
    (* Date: 1996/08/04
    (* Update Date:
    (* -------------------------------------------------- *)
    function CNum2Num(sChineseNum: string; var dblArabic: double): boolean;
    const
      _ChineseNumeric = '十百千万亿兆点零一二三四五六七八九';
      {_ChineseNumeric = '1十3百5千7万9亿11兆13点15零17一19二21三四五六七八九';}
    var
      i: integer;
      iPos: integer;
      dblBuffer: double;
      sMultiChar: string;
      iDigit: integer;
      iRightOfDecimal: integer;
      bMinus: boolean;  (* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
      function EasyPower10(iPower: byte): double;
      var
        i: integer;
      begin
        Result := 1;
        try
          for i := 1 to iPower do Result := Result * 10;
        except
          Result := 0;
        end;
      end;
    begin
      Result := False;
      dblArabic := 0;
      dblBuffer := 0;
      iDigit := -1;
      iRightOfDecimal := -1;  if Copy(sChineseNum, 1, 2) = '负' then
      begin
        sChineseNum := Copy(sChineseNum, 3, 254);
        bMinus := True;
      end
      else
        bMinus := False;  i := 1;
      while i < Length(sChineseNum) do
      begin
        (* 如果不是中文字 ==> Fail *)
        if sChineseNum[i] < #127 then Exit;
        sMultiChar := Copy(sChineseNum, i, 2);
        iPos := Pos(sMultiChar, _ChineseNumeric);
        if iPos = 0 then Exit;
        if (iDigit = -1) and (iPos > 13) then
          iDigit := (iPos - 15) div 2;
        case iPos of
          1, 3, 5:
            begin
              (* 十百千 *)
              if iDigit = -1 then iDigit := 1;
              dblBuffer := dblBuffer + iDigit * EasyPower10((iPos + 1) div 2);
              iDigit := -1;
            end;
          7, 9, 11:
            begin
              (* 万亿兆 *)
              if (iDigit > 0) and (iDigit < 10) then
                dblBuffer := dblBuffer + iDigit;
              dblArabic := dblArabic + dblBuffer * EasyPower10((iPos-5) div 2 * 4);
              iDigit := -1;
              dblBuffer := 0;
            end;
          13:
            begin
              (* 小数点 *)
              if (iDigit > 0) and (iDigit < 10) then
                dblBuffer := dblBuffer + iDigit;
              dblArabic := dblArabic + dblBuffer;
              dblBuffer := 0;
              iDigit := -1;
              iRightOfDecimal := 0;
            end;
          15:  (* 零 *)
            begin
              if iRightOfDecimal > -1 then Inc(iRightOfDecimal);
              iDigit := -1;
            end;
        else
          begin
            if iRightOfDecimal > -1 then
            begin
              (* 小数点右边的部分 *)
              Inc(iRightOfDecimal);
              try
                dblArabic := dblArabic + iDigit / EasyPower10(iRightOfDecimal);
              except
                Exit;
              end;
              iDigit := -1;
            end;
          end;
        end;    {$ifdef __Debug}
        ShowMessage(IntToStr(i) + 'th dblArabic: '  + FloatToStr(dblArabic));
        ShowMessage(IntToStr(i) + 'th dblBuffer: '  + FloatToStr(dblBuffer));
        ShowMessage(IntToStr(i) + 'th iDigit: '  + IntToStr(iDigit));
        {$endif}    Inc(i, 2);
      end;  if (iDigit > 0) and (iDigit < 10) then
        dblBuffer := dblBuffer + iDigit;
      if dblBuffer <> 0 then dblArabic := dblArabic + dblBuffer;
      if bMinus then
      begin
        {$ifdef __SafeMode}
        sChineseNum := '负' + sChineseNum;
        {$endif}
        dblArabic := dblArabic * -1;
      end;
      {$ifdef __SafeMode}
      Result := sChineseNum = Num2CNum(dblArabic);
      {$else}
      Result := True;
      {$endif}
    end;end.
      

  6.   

    别人的
    function realtohz(const Num:Real):String;
    var aa,bb,cc:string;
        bbb:array[1..16]of string;
        uppna:array[0..9] of string;
        i:integer;
    begin
       bbb[1]:='万';
       bbb[2]:='仟';
       bbb[3]:='佰';
       bbb[4]:='拾';
       bbb[5]:='亿';;
       bbb[6]:='仟';;
       bbb[7]:='佰';
       bbb[8]:='拾';
       bbb[9]:='万';
       bbb[10]:='仟';
       bbb[11]:='佰';
       bbb[12]:='拾';
       bbb[13]:='元';
       bbb[14]:='.';
       bbb[15]:='角';
       bbb[16]:='分';
       uppna[1]:='壹';
       uppna[2]:='贰';
       uppna[3]:='叁';
       uppna[4]:='肆';
       uppna[5]:='伍';
       uppna[6]:='陆';
       uppna[7]:='柒';
       uppna[8]:='捌';
       uppna[9]:='玖';
       Str(num:16:2,aa);
       cc:='';
       bb:='';
       result:='';
       for i:=1 to 16 do
         begin
           cc:=aa[i];
           if cc<>' ' then
             begin
              bb:=bbb[i];
               if cc='0' then
                 cc:='零'
               else
                 begin
                   if cc='.' then
                     begin
                       cc:='';
                       bb:='';
                     end
                   else
                     begin
                       cc:=uppna[StrToInt(cc)];
                     end
                 end;
               result:=result+(cc+bb)
             end;
         end;
       //result:=result+'正';
    end;
      

  7.   

    这是我写的大家看看准不准帮我也测一下function TForm1.num_str(s: string): string;
    var b1,b3,str:widestring;
        c1,c2:string;
        i:integer;
        b:boolean;
    begin
      b:=false;
      b1:='元十百千万十百千亿十百千万';    //10000000100.01
      b3:='一二三四五六七八九';
      c1:=copy(s,1,pos('.',s)-1);
      for i:=1 to length(c1) do begin
        c2:=c1[i]+c2;
      end;
      str:='';
      for i:=1 to length(c2) do begin
        if c2[i]='0' then begin
          if (copy(b1,i,1)='万') or (copy(b1,i,1)='亿') or (copy(b1,i,1)='元') then begin
            str:=copy(b1,i,1)+str;
          end else begin
            str:='零'+str;
          end;
        end else begin
          str:=copy(b3,strtoint(c2[i]),1)+copy(b1,i,1)+str;
        end;
      end;
      while not b do begin
        if pos('零万',str)=0 then begin
          break;
        end;
        str:=copy(str,1,pos('零万',str)-1)+copy(str,pos('零万',str)+1,length(str));
      end;
      while not b do begin
        if pos('零零',str)=0 then begin
          break;
        end;
        str:=copy(str,1,pos('零零',str))+copy(str,pos('零零',str)+2,length(str));
      end;
      while not b do begin
        if pos('零亿',str)=0 then begin
          break;
        end;
        str:=copy(str,1,pos('零亿',str)-1)+copy(str,pos('零亿',str)+1,length(str));
      end;
      while not b do begin
        if pos('亿万',str)=0 then begin
          break;
        end;
        str:=copy(str,1,pos('亿万',str))+copy(str,pos('亿万',str)+2,length(str));
      end;
      while not b do begin
        if pos('零元',str)=0 then begin
          break;
        end;
        str:=copy(str,1,pos('零元',str)-1)+copy(str,pos('零元',str)+1,length(str));
      end;
      c1:=copy(s,pos('.',s)+1,length(s));
      if (copy(c1,1,1)='0') and (c1<>'00') then begin
        str:=str+'零'+copy(b3,strtoint(c1[2]),1)+'分';
      end else if (copy(c1,2,1)='0') and (c1<>'00') then begin
        str:=str+copy(b3,strtoint(c1[1]),1)+'角';
      end else if (copy(c1,2,1)<>'0') and (copy(c1,1,1)<>'0') then begin
        str:=str+copy(b3,strtoint(c1[1]),1)+'角'+copy(b3,strtoint(c1[2]),1)+'分';
      end;
      num_str:=str;
    end;