[经典]将阿拉伯数字转成中文数字字串和将中文字串转成拉伯数字

来自32位深度历险台湾钱达智先生  
   
  unit   cutils;  
   
  interface  
   
  uses  
  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.