之前用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;
本文来自博客园,作者:del88,转载请注明原文链接:https://www.cnblogs.com/del88/archive/2012/10/07/2713561.html