delphi 金额转大写人民币函数--百贴整理能用的&用法

之前用Access作一个应用，但找不到货币转换成大写人民币的功能（当然可以通过excel 转换，但不在一个应用上，放弃）。以为比较简单，自己试写，谁知用了两个晚上，才基本实现，但没有小数点（元）以下货币的转换。也没有兆的判断。而且对字符的合法性也没有检验。今天有时间，将其完善一下。（可能还会有考虑不周的地方）

思路：

1、判断是否带有小数点的金额，如果是，就找出小数点所在数据。该位字符不进行转换。

2、小数点前的作为整数位，进行转换。整数位的每一位都有表示金额的级别：拾、佰、仟。而且还有万、亿的级别。

3、小数点后的作为角、分、厘处理。

4、如果有连续的零，只显示一个零。如50006,显示为伍万零陆。如果是发生在拾、佰、仟位，该零还要去掉。

  1 function changeRmb(const strRmb:string):string;
  2 var
  3   txt,strhighlevel:string;
  4   i,n,m,ilen,ipos:Integer;    //n记录整数部分长度，m记录分数部分长度
  5    strarray,strlevel:array of string;
  6    p:pchar;
  7    ispoint:boolean;//判断是否有小数点
  8 begin
  9   ispoint:=false;
 10   result:='';
 11   ipos:=0;
 12   m:=0;
 13   txt:=Trim(strRmb);
 14   i:=1;
 15    p:=PChar(txt);
 16 //去除开头的0，以及.
 17 if ((txt[1]='0') and (txt[2]<>'.')) or (txt[1]='.') then
 18 begin
 19    ShowMessage('第1位不能为0或者是.，退出操作');
 20    exit;
 21 end;
 22 //检查字符的合法性
 23 while (i<length(txt))do
 24 begin
 25 if (p^>'9') or ((p^<'0') and (P^<>'.'))  then //ord('.')=46
 26 begin
 27           ShowMessage(PChar('第'+inttostr(i)+'位包含非数字字符,将退出操作'));
 28           Exit;
 29 end;
 30 if P^='.' then
 31 if ispoint then
 32 begin
 33          showmessage('太多小数点,将退出！');
 34          exit;
 35 end
 36 else
 37 begin
 38         ipos:=i;
 39         ispoint:=true;
 40 end;
 41       Inc(p);
 42       Inc(i);
 43 end;//while
 44    ilen:=Length(txt);
 45 if ispoint then
 46 begin
 47      n:=ipos-1;
 48      m:=ilen-ipos;
 49 end
 50 else
 51     n:=ilen;
 52 //判断是否超过万，或亿
 53 if m>3 then
 54 begin
 55        ShowMessage('小数点后位数超过3，无法转换!');
 56        Exit;
 57 end;
 58   SetLength(strarray,ilen+8);
 59   SetLength(strlevel,ilen+8);
 60 for i:=iLen downto 1 do
 61 begin
 62 if txt[i]<>'.' then
 63 case strtoint(txt[i]) of
 64 1:strarray[i]:='壹';
 65 2:strarray[i]:='贰';
 66 3:strarray[i]:='叁';
 67 4:strarray[i]:='肆';
 68 5:strarray[i]:='伍';
 69 6:strarray[i]:='陆';
 70 7:strarray[i]:='柒';
 71 8:strarray[i]:='捌';
 72 9:strarray[i]:='玖';
 73 0:
 74 begin
 75          strarray[i]:='零';
 76 if i<ilen then //如果低位也为零，低位零不显示
 77 if (strarray[i+1]= '') or (strarray[i+1]= '零') then
 78 begin
 79 //strarray[i+1]:= '';
 80               strarray[i]:= '';
 81 end;
 82 if i=n then strarray[i]:='';
 83          strlevel[i]:='';
 84 end;
 85 end; //case
 86 end;
 87 //先处理 小数点部分
 88 if m>0 then
 89 begin
 90 for i:=m downto 1 do
 91 begin
 92         strlevel[ipos+i]:='';
 93 case i-1 of
 94 0:
 95 if  txt[ipos+i]='0' then
 96                 strarray[ipos+i]:=''
 97 else
 98                strlevel[ipos+i]:='角';
 99 1:
100 if  txt[ipos+i]='0' then
101                   strarray[ipos+i]:=''
102 else
103                strlevel[ipos+i]:='分';
104 2:
105 if  txt[ipos+i]='0' then
106                strarray[ipos+i]:=''
107 else   strlevel[ipos+i]:='厘';
108 end;
109        Result:=strarray[ipos+i]+strlevel[ipos+i]+result;
110 end;
111 end;
112 if ispoint and (txt[ipos-1]='0') and (n=1) then
113     Result:=result+'' //如果少于1块时，不要显示元。
114 else
115     Result:='元'+result;
116 for i:=n downto 1 do
117 begin
118 case n-i of
119 0,4,8,12: strlevel[i]:='';
120 1,5,9,13: strlevel[i]:='拾';
121 2,6,10,14: strlevel[i]:='佰';
122 3,7,11,15: strlevel[i]:='仟';
123 end; //case
124 if (txt[i]='0')  then strlevel[i]:='';
125 //要处理零 以及加上万、亿
126 if n-i=4 then
127 begin
128 if  strarray[i]='零' then   strarray[i]:='';
129       Result:=strarray[i]+strlevel[i]+'万'+result
130 end
131 else if n-i=8 then
132 begin
133 if  strarray[i]='零' then   strarray[i]:='';
134       Result:=strarray[i]+strlevel[i]+'亿'+result
135 end //begin
136 else if n-i=12 then
137 begin
138 if  strarray[i]='零' then   strarray[i]:='';
139       Result:=strarray[i]+strlevel[i]+'兆'+result
140 end //begin
141 else
142     Result:=strarray[i]+strlevel[i]+result;
143 end; //for
144 end;

Delphi版金额大写(人民币大写读数)代码

  1 function Money2ChineseCapital2(const Num:double ): WideString;
  2 var
  3  szNum:PWideChar;
  4   i,iLen,iLen2, iNum, iAddZero,ResultCount:Integer;
  5   buff:AnsiString;
  6   buf:PAnsiChar;
  7 
  8   dblNum: Double;
  9 
 10 const  mnUnit:WideString ='分角元';
 11 const  OtherWords:WideString='整负';
 12 const  hzUnit:WideString = '拾佰仟万拾佰仟亿';
 13 const  hzNum:WideString='零壹贰叁肆伍陆柒捌玖';
 14 begin
 15   SetLength(Result,33*2 + 1);
 16    iAddZero := 0;
 17  if Num < 0.0 then
 18    dblNum := Num * 100.0 + 0.5
 19  else
 20    dblNum := Num * 100.0 - 0.5;
 21 
 22  buff := format('%0.0f',[dblNum]);
 23  if Pos(buff,'e')>0 then begin
 24     SetLength(Result,0);
 25   Raise Exception.Create('数值过大!');
 26    Exit;
 27    end;
 28  iLen := Length(buff);
 29    szNum := PWideChar(Result);
 30    buf := PAnsiChar(buff);
 31   if(Num<0.0) then
 32    begin
 33       szNum^:=OtherWords[2];
 34      Inc(szNum);
 35      Inc(buf);
 36      Dec(iLen);
 37   end;
 38   for i:=1 to iLen do
 39   begin
 40      iNum :=Ord(buf^)-48;
 41       Inc(buf);
 42      iLen2 := iLen-i;
 43       if(iNum=0) then
 44    begin
 45          if(((iLen2-2) mod 4)=0) and ((iLen2-3)>0) and (((iLen2>=8) or (iAddZero<3))) then
 46         begin
 47            szNum^ := hzUnit[(iLen2-3) mod 8 + 1];
 48            Inc(szNum);
 49          end;
 50          Inc(iAddZero);
 51          if(iLen>1) and (iLen2=1) and (buff[iLen] <> '0') then
 52         begin
 53             szNum^:=hzNum[1];
 54             Inc(szNum);
 55         end;
 56       end
 57       else
 58       begin
 59         if(((iAddZero>0) and (iLen2>=2)) and (((iLen2-1) mod 4)<>0) or ((iAddZero>=4) and ((iLen2-1)>0))) then
 60       begin
 61             szNum^:=hzNum[1];
 62             Inc(szNum);
 63         end;
 64         szNum^:=hzNum[iNum+1];
 65        Inc(szNum);
 66        iAddZero:=0;
 67      end;
 68      if (iAddZero<1) or (iLen2=2) then
 69       begin
 70         if(iLen-i>=3) then
 71         begin
 72           szNum^:=hzUnit[(iLen2-3) mod 8 + 1];
 73           Inc(szNum);
 74         end
 75         else
 76          begin
 77           szNum^:=mnUnit[(iLen2) mod 3 +1 ];
 78            Inc(szNum);
 79        end;
 80     end;
 81    end;
 82    ResultCount := szNum-PWideChar(Result);
 83   if((Num < 0.0) and (ResultCount - 1 = 0)) or ((Num>=0.0) and (ResultCount=0)) then
 84    begin
 85      szNum^:=hzNum[1];
 86      Inc(szNum);
 87      szNum^:=mnUnit[3];
 88    Inc(szNum);
 89    szNum^:=OtherWords[1];
 90      Inc(szNum);
 91     Inc(ResultCount,3);
 92  end
 93   else
 94   if((Num<0.0) and (buff[iLen+1] ='0')) or ((Num>=0.0) and (buff[iLen] ='0')) then
 95    begin
 96       szNum^:=OtherWords[1];
 97      Inc(ResultCount);
 98    end;
 99 
100   SetLength(Result, ResultCount);
101 end;

方法二：

 1 function LowToUpcase(xx: Real): string;
 2 var
 3   i: Integer;
 4   j,dxhj: string;
 5   zero: boolean;
 6 begin
 7   j := FormatFloat('0.0',xx);
 8   j := Trim(IntToStr(Round(xx*100)));
 9   if pos('.',j) <> 0 then
10     j := Copy(j,1,pos('.',j)-1);
11   if j = '' then
12     j:='0';
13   if copy(j,length(j),1) = '0' then
14   begin
15     dxhj := '整';
16     zero := True;
17   end
18   else
19   begin
20     dxhj := '';
21     zero := False;
22   end;
23 
24   for i := 0 to Length(j)-1 do
25   begin
26     if StrToInt(Copy(j,Length(j)-i,1)) <> 0 then
27     case i of
28       0: dxhj := '分'+dxhj;
29       1: dxhj := '角'+dxhj;
30       2: dxhj := '元'+dxhj;
31       3: dxhj := '拾'+dxhj;
32       4: dxhj := '佰'+dxhj;
33       5: dxhj := '仟'+dxhj;
34       6: dxhj := '万'+dxhj;
35       7: dxhj := '拾'+dxhj;
36       8: dxhj := '佰'+dxhj;
37       9: dxhj := '仟'+dxhj;
38       10: dxhj := '亿'+dxhj;
39       11: dxhj := '拾'+dxhj;
40     end;
41 
42     case StrToInt(Copy(j,Length(j)-i,1)) of
43       0:
44       begin
45         if not zero then
46           dxhj := '零'+dxhj;
47         zero := True;
48       end;
49       1:
50       begin
51         dxhj := '壹'+dxhj;
52         zero := False;
53       end;
54       2:
55       begin
56         dxhj := '贰'+dxhj;
57         zero := False;
58       end;
59       3:
60       begin
61         dxhj := '叁'+dxhj;
62         zero := False;
63       end;
64       4:
65       begin
66         dxhj := '肆'+dxhj;
67         zero := False;
68       end;
69       5:
70       begin
71         dxhj := '五'+dxhj;
72         zero := False;
73       end;
74       6:
75       begin
76         dxhj := '六'+dxhj;
77         zero := False;
78       end;
79       7:
80       begin
81         dxhj := '七'+dxhj;
82         zero := False;
83       end;
84       8:
85       begin
86         dxhj := '八'+dxhj;
87         zero := False;
88       end;
89       9:
90       begin
91         dxhj := '玖'+dxhj;
92         zero := False;
93       end;
94     end;
95   end;
96   if dxhj = '整' then
97     dxhj := '';
98   Result := dxhj;
99 end;

方法三：

 1     function   MoneyCn(mMoney:   Real):   WideString;
 2 
 3     var
 4 
 5     P:   Integer;
 6 
 7     begin
 8 
 9     if   mMoney   =   0   then   begin
10 
11     Result   :=   '无';
12 
13     Exit;
14 
15     end;
16 
17     Result   :=   NumberCn(Round(mMoney   *   100)   /   100);
18 
19     Result   :=   StringReplace(Result,   '一',   '壹',   [rfReplaceAll]);
20 
21     Result   :=   StringReplace(Result,   '二',   '贰',   [rfReplaceAll]);
22 
23     Result   :=   StringReplace(Result,   '三',   '叁',   [rfReplaceAll]);
24 
25     Result   :=   StringReplace(Result,   '四',   '肆',   [rfReplaceAll]);
26 
27     Result   :=   StringReplace(Result,   '五',   '伍',   [rfReplaceAll]);
28 
29     Result   :=   StringReplace(Result,   '六',   '陆',   [rfReplaceAll]);
30 
31     Result   :=   StringReplace(Result,   '七',   '柒',   [rfReplaceAll]);
32 
33     Result   :=   StringReplace(Result,   '八',   '捌',   [rfReplaceAll]);
34 
35     Result   :=   StringReplace(Result,   '九',   '玖',   [rfReplaceAll]);
36 
37     Result   :=   StringReplace(Result,   '九',   '玖',   [rfReplaceAll]);
38 
39     Result   :=   StringReplace(Result,   '十',   '拾',   [rfReplaceAll]);
40 
41     Result   :=   StringReplace(Result,   '百',   '佰',   [rfReplaceAll]);
42 
43     Result   :=   StringReplace(Result,   '千',   '仟',   [rfReplaceAll]);
44 
45     P   :=   Pos('点',   Result);
46 
47     if   P   >   0   then   begin
48 
49     Insert('分',   Result,   P   +   3);
50 
51     Insert('角',   Result,   P   +   2);
52 
53     Result   :=   StringReplace(Result,   '点',   '圆',   [rfReplaceAll]);
54 
55     Result   :=   StringReplace(Result,   '角分',   '角',   [rfReplaceAll]);
56 
57     Result   :=   StringReplace(Result,   '零分',   '',   [rfReplaceAll]);
58 
59     Result   :=   StringReplace(Result,   '零角',   '',   [rfReplaceAll]);
60 
61     Result   :=   StringReplace(Result,   '分角',   '',   [rfReplaceAll]);
62 
63     if   Copy(Result,   1,   2)   =   '零圆'   then
64 
65     Result   :=   StringReplace(Result,   '零圆',   '',   [rfReplaceAll]);
66 
67     end   else   Result   :=   Result   +   '圆整';
68 
69     Result   :=   '人民币'   +   Result;
70 
71     end;

另附：转成小写人民币函数：

 1   function   NumberCn(mNumber:   Real):   WideString;
 2 
 3     const
 4 
 5     cPointCn:   WideString   =   '点十百千万十百千亿十百千';
 6 
 7     cNumberCn:   WideString   =   '零一二三四五六七八九';
 8 
 9     var
10 
11     I,   L,   P:   Integer;
12 
13     S:   string;
14 
15     begin
16 
17     Result   :=   '';
18 
19     if   mNumber   =   0   then   begin
20 
21     Result   :=   cNumberCn[1];
22 
23     Exit;
24 
25     end;
26 
27     S   :=   FloatToStr(mNumber);
28 
29     if   Pos('.',   S)   <=   0   then   S   :=   S   +   '.';
30 
31     P   :=   Pos('.',   S);
32 
33     L   :=   Length(S);
34 
35     for   I   :=   1   to   L   do
36 
37     if   P   >   I   then
38 
39     Result   :=   Result   +   cNumberCn[StrToInt(S[I])   +   1]   +   cPointCn[P   -   I]
40 
41     else   if   P   =   I   then   begin
42 
43     Result   :=   StringReplace(Result,   '零十零',   '零',   [rfReplaceAll]);
44 
45     Result   :=   StringReplace(Result,   '零百零',   '零',   [rfReplaceAll]);
46 
47     Result   :=   StringReplace(Result,   '零千零',   '零',   [rfReplaceAll]);
48 
49     Result   :=   StringReplace(Result,   '零十',   '零',   [rfReplaceAll]);
50 
51     Result   :=   StringReplace(Result,   '零百',   '零',   [rfReplaceAll]);
52 
53     Result   :=   StringReplace(Result,   '零千',   '零',   [rfReplaceAll]);
54 
55     Result   :=   StringReplace(Result,   '零万',   '万',   [rfReplaceAll]);
56 
57     Result   :=   StringReplace(Result,   '零亿',   '亿',   [rfReplaceAll]);
58 
59     Result   :=   StringReplace(Result,   '亿万',   '亿',   [rfReplaceAll]);
60 
61     Result   :=   StringReplace(Result,   '零点',   '点',   [rfReplaceAll]);
62 
63     end   else   if   P   <   I   then
64 
65     Result   :=   Result   +   cNumberCn[StrToInt(S[I])   +   1];
66 
67     if   Result[Length(Result)]   =   cPointCn[1]   then
68 
69     Result   :=   Copy(Result,   1,   Length(Result)   -   1);
70 
71     if   Result[1]   =   cPointCn[1]   then   Result   :=   cNumberCn[1]   +   Result;
72 
73     if   (Length(Result)   >   1)   and   (Result[2]   =   cPointCn[2])   and
74 
75     (Result[1]   =   cNumberCn[2])   then
76 
77     Delete(Result,   1,   1);
78 
79     end;   {   NumberCn   }

5.园子：http://www.delphifans.com/infoview/Article_167.html

方法一：

 1 function NumToChar(const n: Real): string;   //可以到万亿，并且可以随便扩大范围
 2   const cNum: WideString = '零壹贰叁肆伍陆柒捌玖--万仟佰拾亿仟佰拾万仟佰拾元角分';
 3         cCha:array[0..1, 0..12]of string =
 4         (( '零元','零拾','零佰','零仟','零万','零亿','亿万','零零零','零零','零万','零亿','亿万','零元'),
 5          ( '元','零','零','零','万','亿','亿','零','零','万','亿','亿','元'));
 6   var i : Integer;
 7       sNum,sTemp : WideString;
 8 begin
 9   result :='';
10   sNum := format('%15d',[round(n * 100)]);
11   for i := 0 to 14 do
12   begin
13     stemp := copy(snum,i+1,1);
14     if stemp=' ' then continue
15     else result := result + cNum[strtoint(stemp)+1] + cNum[i+13];
16   end;
17   for i:= 0 to 12 do
18   Result := StringReplace(Result, cCha[0,i], cCha[1,i], [rfReplaceAll]);
19   if pos('零分',result)=0
20     then Result := StringReplace(Result, '零角', '零', [rfReplaceAll])
21     else Result := StringReplace(Result, '零角','整', [rfReplaceAll]);
22   Result := StringReplace(Result, '零分','', [rfReplaceAll]);
23 end;

方法二：

 1 function MoneytoUpper(MoneySmall: double): string;
 2 //人民币金额大小写转换函数
 3   function IIF(b: boolean; s1, s2: string): string;
 4   begin
 5     if b then IIF := s1 else IIF := s2;
 6   end;
 7 const c: WideString = '零壹贰叁肆伍陆柒捌玖◇分角元拾佰仟万拾佰仟亿拾佰仟万';
 8 var L, i, n: integer;
 9   Z, a: boolean;
10   s, st: WideString;
11 begin
12   s := FormatFloat('0', Abs(MoneySmall * 100));
13   L := Length(s);
14   Z := false;
15   for i := 1 to L do
16   begin
17     n := ord(s[L - i + 1]) - 48; // StrToInt( s[L-i+1]);
18     a := (i = 11) or (i = 7) or (i = 3) or (i = 1); //亿、万、元、分位
19     st := IIF((n = 0) and (Z or a), '', c[n + 1]) //数值
20       + IIF((n = 0) and (i = 1), '整', //分位为零
21       IIF((n > 0) or a, c[i + 11], '')) //单位
22       + IIF((n = 0) and (not Z) and (i > 1) and a, '零', '') //亿、万、元位为零而千万、千、角位不为零
23       + st;
24     Z := n = 0;
25   end;
26   for i := 1 to Length(st) do
27     if Copy(st, i, 2) = '亿万' then Delete(st, i + 1, 1); //亿位和万位之间都是零时会出现’亿万’
28   result := IIF(MoneySmall > 9999999999999.99, '溢出', IIf(MoneySmall = 0, '零', IIF(MoneySmall < 0, '(负数)' + st, st)));
29 end;

方法三(最终选择这个,目前在用这个,貌似比上面的升级了下从这里FormatFloat可以看出)：

 1 //转换成大写人民币(可以到万亿,并可随便扩大)
 2 function MyMoneyToCn(n: Real): string;
 3 const
 4   cNum: WideString = '零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分';
 5   cCha: array[0..1, 0..11] of string =(('零仟','零佰','零拾','零零零','零零','零亿','零万','零元','亿万','零角','零分','零整'),('零','零','零','零','零','亿','万','元','亿','零','整','整'));
 6 var
 7   i: Integer;
 8   sNum: WideString;
 9 begin
10   Result := '';
11   sNum := FormatFloat('0',n*100);
12   for i := 1 to Length(sNum) do
13     Result := Result + cNum[ord(sNum[i])-47] + cNum[26-Length(sNum)+i];
14   for i:= 0 to 11 do // 去掉多余的零
15     Result := StringReplace(result, cCha[0,i], cCha[1,i], [rfReplaceAll]);
16 end;

==========================================================================================

fastreport中的用法：

1.把函数写在窗体的上方

//======================================start-必须写在这里的函数=======================================

//转换成大写人民币(可以到万亿,并可随便扩大)
function MyMoneyToCn(n: Real): string;
const
  cNum: WideString = '零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分';
  cCha: array[0..1, 0..11] of string =(('零仟','零佰','零拾','零零零','零零','零亿','零万','零元','亿万','零角','零分','零整'),('零','零','零','零','零','亿','万','元','亿','零','整','整'));
var
  i: Integer;
  sNum: WideString;
begin
  Result := '';
  sNum := FormatFloat('0',n*100);
  for i := 1 to Length(sNum) do
    Result := Result + cNum[ord(sNum[i])-47] + cNum[26-Length(sNum)+i];
  for i:= 0 to 11 do // 去掉多余的零
    Result := StringReplace(result, cCha[0,i], cCha[1,i], [rfReplaceAll]);
end;

//======================================end---必须写在这里的函数=======================================

2.把模板加载函数的加载写在窗体的创建事件中

procedure TfrmFastPrint.FormCreate(Sender: TObject);
begin
  {
    自定义函数加到模板中,由于这个是增加一次的,
    且没有free所以必须在这里加,才完美正确,如果在编辑模板按钮
    事件中加,美编辑一次就会增加一次,如果在打印按钮中增加,点打印
    一批就会增加一次这个函数,虽不会影响使用,但是这样,会造成可能未知
    的错误,所以必须写在这.资料也推荐写在这
  }
  MyPrintTopLogisticsCompanyFr.AddFunction('function MyMoneyToCn(n: Real): string','MyFunctionApi','人民币大写金额转换函数');
  MyPrintTopOrderInvoiceFr.AddFunction('function MyMoneyToCn(n: Real): string','MyFunctionApi','人民币大写金额转换函数');
end;

3.在fr控件的onuserfunction事件中写代码：

function TfrmFastPrint.MyPrintTopLogisticsCompanyFrUserFunction(
  const MethodName: string; var Params: Variant): Variant;
begin
  //避免函数大小写的问题
  if UpperCase(MethodName) = UpperCase('MyMoneyToCn') then
    Result := MyMoneyToCn(Params[0]);
end;

posted on 2012-10-07 09:47 del88 阅读(37) 评论(0) 编辑收藏举报