大写金额转化成数字小写金额

Question

大写金额的有了
那如何能把大写金额转化成小写金额，比如 壹亿零壹元转化成数字

Answer 1

function ChineseCapital2Money(Capital:WideString): double;
var
  szNum:PWideChar;
  Sign: double;
  dblCurrent: Double;
  I,iCount: Integer;
begin
  Result := 0;
  iCount := Length(Capital);
  szNum := PWideChar(Capital);  if szNum^ = #$8d1f(*'负'*) then begin
    Sign := -1;
    Inc(szNum);
    Dec(iCount);
  end else begin
    Sign := 1;
  end;  while iCount > 0 do
    begin
      case szNum^ of
        #$96f6(*'零'*): begin
          dblCurrent := 0;
        end;
        #$58f9(*'壹'*): begin
          dblCurrent := 1;
        end;
        #$8d30(*'贰'*): begin
          dblCurrent := 2;
        end;
        #$53c1(*'叁'*): begin
          dblCurrent := 3;
        end;
        #$8086(*'肆'*): begin
          dblCurrent := 4;
        end;
        #$4f0d(*'伍'*): begin
          dblCurrent := 5;
        end;
        #$9646(*'陆'*): begin
          dblCurrent := 6;
        end;
        #$67d2(*'柒'*): begin
          dblCurrent := 7;
        end;
        #$634c(*'捌'*): begin
          dblCurrent := 8;
        end;
        #$7396(*'玖'*): begin
          dblCurrent := 9;
        end;        //十百千
        #$62fe(*'拾'*): begin
          Result := Result + dblCurrent * 10.0;
        end;
        #$4f70(*'佰'*): begin
          Result := Result + dblCurrent * 100.0;
        end;
        #$4edf(*'仟'*): begin
          Result := Result + dblCurrent * 1000.0;
        end;        //万亿
        #$4e07(*'万'*): begin
          Result := (Result + dblCurrent) * 10000.0;
        end;
        #$4ebf(*'亿'*): begin
          Result := (Result + dblCurrent) * 100000000.0;
        end;        //元角分
        #$5143(*'元'*): begin
          Result := Result + dblCurrent;
        end;
        #$89d2(*'角'*): begin
          Result := Result + dblCurrent * 0.1;
        end;
        #$5206(*'分'*): begin
          Result := Result + dblCurrent * 0.01;
          break;
        end;        //整
        #$6574(*'整'*): begin
          break;
        end;
        else
          Raise Exception.Create('输入源错误!');      end;
      Inc(szNum);
    end;  Result := Result * Sign;
end;

Answer 2

Inc(szNum);
后面少了:
Dec(iCount);

Answer 3

需要注意的,由于浮点数的本质,会存在误差,如果数值不是太大,建议使用Currency替代Double
function ChineseCapital2Money(Capital:WideString): double;
var
  szNum:PWideChar;
  Sign: double;
  dblCurrent: Double;
  I,iCount: Integer;
begin
  Result := 0;
  iCount := Length(Capital);
  szNum := PWideChar(Capital);  if szNum^ = #$8d1f(*'负'*) then begin
    Sign := -1;
    Inc(szNum);
    Dec(iCount);
  end else begin
    Sign := 1;
  end;  while iCount > 0 do
    begin
      case szNum^ of
        #$96f6(*'零'*): begin
          dblCurrent := 0;
        end;
        #$58f9(*'壹'*): begin
          dblCurrent := 1;
        end;
        #$8d30(*'贰'*): begin
          dblCurrent := 2;
        end;
        #$53c1(*'叁'*): begin
          dblCurrent := 3;
        end;
        #$8086(*'肆'*): begin
          dblCurrent := 4;
        end;
        #$4f0d(*'伍'*): begin
          dblCurrent := 5;
        end;
        #$9646(*'陆'*): begin
          dblCurrent := 6;
        end;
        #$67d2(*'柒'*): begin
          dblCurrent := 7;
        end;
        #$634c(*'捌'*): begin
          dblCurrent := 8;
        end;
        #$7396(*'玖'*): begin
          dblCurrent := 9;
        end;        //十百千
        #$62fe(*'拾'*): begin
          Result := Result + dblCurrent * 10.0;
          dblCurrent := 0;
        end;
        #$4f70(*'佰'*): begin
          Result := Result + dblCurrent * 100.0;
          dblCurrent := 0;
        end;
        #$4edf(*'仟'*): begin
          Result := Result + dblCurrent * 1000.0;
          dblCurrent := 0;
        end;        //万亿
        #$4e07(*'万'*): begin
          Result := (Result + dblCurrent) * 10000.0;
          dblCurrent := 0;
        end;
        #$4ebf(*'亿'*): begin
          Result := (Result + dblCurrent) * 100000000.0;
          dblCurrent := 0;
        end;        //元角分
        #$5143(*'元'*): begin
          Result := Result + dblCurrent;
          dblCurrent := 0;
        end;
        #$89d2(*'角'*): begin
          Result := Result + dblCurrent * 0.1;
          dblCurrent := 0;
        end;
        #$5206(*'分'*): begin
          Result := Result + dblCurrent * 0.01;
          dblCurrent := 0;
          break;
        end;        //整
        #$6574(*'整'*): begin
          break;
        end;
        else
          Raise Exception.Create('输入源错误!');      end;
      Inc(szNum);
      Dec(iCount);
    end;  Result := Result * Sign;
end;

Answer 4

function CC2M(S: WideString): double;
const
  Src1 : WideString = '壹贰叁肆伍陆柒捌玖零';
  Src2 : WideString = '拾佰仟万万万万亿';
  Src3 : WideString = '角分';
var
  I: integer;
  B, V : integer;
begin
  Result := 0;
  B := 0;
  for I := 1 to Length(S) do begin
    if Pos(S[I], Src1) > 0 then begin
      B := Pos(S[I], Src1);
      if S[I] = '零' then B := -1;
    end;
    if (Pos(S[I], Src2)>0) and (B<>-1) then begin
      V := Pos(S[I], Src2);
      if B=0 then
        Result := Result * Power(10, V)
      else
        Result := Result + B*Power(10, V);
      B := 0;
    end;
    if (S[I] = '圆') and (B<>-1) then begin
      Result := Result + B;
      B := -1;
    end;
    if (Pos(S[I], Src3)>0) and (B<>-1) then begin
      V := Pos(S[I], Src3);
      Result := Result + B / Power(10, V);
    end;
  end;
end;{ 以下是测试。比较大的数字没有把握。}
procedure TForm1.Button1Click(Sender: TObject);
var
  S: WideString;
begin
  S := '叁角';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '叁圆叁角';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '叁拾伍圆叁角';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '叁仟零叁拾伍圆叁角';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '伍佰万陆仟零叁拾伍圆整';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '壹仟零陆拾万叁拾伍圆叁角伍分';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '玖亿圆';
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
  S := '玖亿柒仟伍佰万陆佰陆拾捌圆伍角叁分';//这样大的数字，没有把握了。不过此数字测试与僵哥的结果一样。
  Memo1.Lines.Add(S);
  Memo1.Lines.Add(FloattoStr(CC2M(S)));
end;

Answer 5

-_- !需要：use Math;

Answer 6

我也来一个，有空再测试效率function RmbToNum(const S:WideString):string;
  //===[posex对widestring居然返回错值，只有自己写一个
  function PosWStr(SubStr:WideChar;S:WideString;Offset:Integer=1):Integer;
  begin
    Result:=0;
    while offset<=Length(s) do
    begin
      if SubStr=s[offset] then
      begin
        Result:=Offset;
        Offset:=Length(s);
      end;
      inc(Offset);
    end;
  end;  //==========]
  //===[分段处理,整数部分Flag=1,小数部分Flag:=0
  function RMBPart(s,ARmbUnits:WideString;Flag:integer):string;
  const
    AUpper:WideString='零壹贰叁肆伍陆柒捌玖';
  var
    Amount,sNum:WideString;
    i,n,k:integer;
    IsNum:Boolean;
  begin
    i:=Length(s);
    if (Flag=0)and (pos(s[i],ARmbUnits)=0) then
    begin
      ShowMessage('非0值小数只能到厘');
      Exit;
    end;
    k:=1;
    IsNum:=False;
    while i>0 do
    begin
      n:=PosWStr(s[i],ARmbUnits,k);
      if n>0 then
      begin
        k:=n+1;
        i:=i-1;
      end;   //if n>0
      n:=Pos(s[i],AUpper);
      if n>1 then
      begin
        sNum:=IntToStr(n-1)+StringOfChar('0',k-2);
        i:=i-1;
        IsNum:=True;
      end
      else if n=1 then i:=i-1;
      if IsNum then
      begin
        Amount:=copy(sNum,1,length(sNum)-length(Amount))+Amount;
      end;
    end;  //while i>0
    if Flag=1 then Result:=Amount
    else Result:='.'+StringOfChar('0',3-k+1)+Amount; //加小数点
  end;//===========]const
  AInt:WideString='元拾佰仟万拾佰仟亿拾佰仟万拾佰仟';
  ADecimal:WideString='厘分角';
var
  dotPos,Len:integer;
  sInt,sDecimal:WideString;
begin
  Len:=Length(s);
  dotPos:=Pos('元',s);
  if dotPos=0 then
    Result:='0'+RMBPart(s,ADecimal,0)
  else
  if dotPos=Len then
    Result:=RMBPart(s,AInt,1)
  else
  begin
    sInt:=Copy(s,1,dotPos-1);
    sDecimal:=Copy(s,dotPos+1,Len-dotPos);
    Result:=RMBPart(sInt,AInt,1)+RMBPart(sDecimal,ADecimal,0);
  end;
end;

Answer 7

测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，lihuasoft耗时:0lihuasoft的有错，我把你的圆已经改成元了
===================
测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，unsigned耗时:0unsighed也一样的错，
===============
没法比较效率，
嘎嘎，看来俺赚定了

Answer 8

测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分
1000100011.12----s
1000100011.120
循环1次，mygodsos耗时:0
1000100011.12----s
10000000100011.119
循环1次，lihuasoft耗时:0
1000100011.12----s
10000000100011.119
循环1次，unsigned耗时:0
======================
请看另外你说的
“10000000100011也可以理解为：1000100011” 
这个我不理解。
“从字面上讲，都说得通。所以，用大写金额描述亿级以上的数据，本身就不具备实用性。” 
这个我也不理解，亿元用得很多，我接触到的合同，嘿嘿

Answer 9

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]); 
   if Pos(buff,'e')>0 then begin 
    SetLength(Result,0); 
    Raise Exception.Create('数值过大!'); 
    Exit; 
   end; 
   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) and (buff[iLen] <> '0') 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^:=hzNum[1]; 
            Inc(szNum); 
         end; 
         szNum^:=hzNum[iNum+1]; 
         Inc(szNum); 
         iAddZero:=0; 
      end; 
      if (iAddZero<1) or (iLen2=2) then 
      begin 
         if(iLen-i>=3) then 
         begin 
            szNum^:=hzUnit[(iLen2-3) mod 8 + 1]; 
            Inc(szNum); 
         end 
         else 
         begin 
            szNum^:=mnUnit[(iLen2) mod 3 +1 ]; 
            Inc(szNum); 
         end; 
      end; 
   end; 
   ResultCount := szNum-PWideChar(Result); 
   if((Num < 0.0) and (ResultCount - 1 = 0)) or ((Num>=0.0) and (ResultCount=0)) then 
   begin 
      szNum^:=hzNum[1]; 
      Inc(szNum); 
      szNum^:=mnUnit[3]; 
      Inc(szNum); 
      szNum^:=OtherWords[1]; 
      Inc(szNum); 
      Inc(ResultCount,3); 
   end 
   else 
   if((Num<0.0) and (buff[iLen+1] ='0')) or ((Num>=0.0) and (buff[iLen] ='0')) then 
   begin 
      szNum^:=OtherWords[1]; 
      Inc(ResultCount); 
   end;    SetLength(Result, ResultCount); 
end;

Answer 10

19楼在照搬unsigned的上一篇的转成大写金额的代码，真无聊，那个代码我昨天可是仔细研究过的