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

[xxaacc]

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

[僵哥]

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;

[僵哥]

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

[僵哥]

需要注意的,由于浮点数的本质,会存在误差,如果数值不是太大,建议使用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;

[lihuasoft]

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;

[lihuasoft]

PS：注意，我的函数里用的是“圆”而不是“元”，如不符合会计规则请自行更改。

[lihuasoft]

-_- !

需要：

use Math;

[僵哥]

[Quote=引用 8 楼 lihuasoft 的回复:]
PS：注意，我的函数里用的是“圆”而不是“元”，如不符合会计规则请自行更改。
[/Quote]
在实际应用当中"元"和"圆"都是可以使用的,同时也都是被认同的.在早年,确实曾经有老会计强令要求使用"圆"而不是"元",但是就目前的货币发行当中可以看出,在人民币当中有使用"元"也有使用"圆".之所以会计要求使用大写代替小写或数字,就是为了防止篡改.而对于"万"和"元"本来并不存在可篡改特性,所以现在已经放宽要求,而不一定要求使用"萬"和"圆"(实际上"元"并不是"圆"的简写,"元"的无简繁之分,而"圆"则是"圓"的简写)

[mygodsos]

测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，lihuasoft耗时:0

lihuasoft的有错，我把你的圆已经改成元了
===================
测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，unsigned耗时:0

unsighed也一样的错，
===============
没法比较效率，
嘎嘎，看来俺赚定了

[mygodsos]

[Quote=引用 3 楼 3150379 的回复:]
正如楼上如说，技术含量低，就是麻烦
[/Quote]反对这种态度，看了你上篇的，你的程序没对

[lihuasoft]

to：乌龙哈里：

说说我自己的观点：

壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
-----------
首先，这个问题是面向实际应用的，“厘”根本就没有必要出现。

然后，大写金额如果处理到“亿”级，本身在表达上就存在二义性。例如：

壹拾亿零壹拾万零壹拾壹元

---可以理解为：“壹拾亿零壹拾”个万，再加上“壹拾壹元”，其结果就是：
1000000010*10000 + 11 = 10000000100011
---也可以理解为：1000100011

这两种理解，从字面上讲，都说得通。所以，用大写金额描述亿级以上的数据，本身就不具备实用性。

当然，如果完全用会计单据的固定格式来描述，就不会出错了：

壹 拾亿 ◇ 亿 ◇ 仟万 ◇ 佰万 壹拾 万 ◇ 万 ◇ 仟 ◇ 佰 壹 拾 壹 元 整

如果以这种形式的字串转换为小写，那算法会更加简单


如果抛除上述“厘”、“亿级以上大写二义”这两个问题，我不知你说我的代码、僵哥的代码有错，错在何处。

[mygodsos]

测试环境：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”
这个我不理解。
“从字面上讲，都说得通。所以，用大写金额描述亿级以上的数据，本身就不具备实用性。”
这个我也不理解，亿元用得很多，我接触到的合同，嘿嘿

[lzd123]

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;

[mygodsos]

我不想争谁对谁错，这个是楼主的事

我只是想看看有没有更有效率的方法，我也好改进我的代码

当初写这个代码的时候也是从网上弄了一堆没测试过的的代码，后面实在没办法了才自己写

[mygodsos]

19楼在照搬unsigned的上一篇的转成大写金额的代码，

真无聊，那个代码我昨天可是仔细研究过的

[僵哥]

[Quote=引用 15 楼 mygodsos 的回复:]
测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，lihuasoft耗时:0

lihuasoft的有错，我把你的圆已经改成元了
===================
测试环境：delphi2007 Winxp sp3
壹拾亿零壹拾万零壹拾壹元壹角贰分叁厘
1000100011.123
10000000100011.119
循环50000次，unsigned耗时:0

unsighed也一样的错，
===============
没法比较…
[/Quote]
在六楼我就已经提示过了.

[僵哥]

[Quote=引用 21 楼 mygodsos 的回复:]
19楼在照搬unsigned的上一篇的转成大写金额的代码，

真无聊，那个代码我昨天可是仔细研究过的
[/Quote]
19楼的在梦游

[mygodsos]

我也来一个，有空再测试效率

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;

[僵哥]

要求金额大写的场合通常与会计工作有关.要求精确到的最小单位是"分",而不会出现单位"厘"

[auqfiudh]

0,000.00

[火龙岛主]

[Quote=引用 8 楼 lihuasoft 的回复:]
PS：注意，我的函数里用的是“圆”而不是“元”，如不符合会计规则请自行更改。
[/Quote]
会计准则明确规定，使用“元”或“圆”都是可以的。