function TPrintfrm.NumToChar(n: Real): wideString; //可以到万亿,并可随便扩大 const cNum: WideString = '零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分'; cCha: array[0..1, 0..11] of string = (('零仟','零佰','零拾','零零零','零零', '零亿','零万','零元','亿万','零角','零分','零整'), ( '零','零','零','零','零','亿','万','元','亿','零','整','整')); var i: Integer; sNum :WideString; begin Result := ''; //n := Round(n*10)/10; //FormatFloat('0.0',) 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;
第二种方法function TSnnofrm.LowToUpcase(xx: Real): string; var i: Integer; j,dxhj: string; zero: boolean; begin j := FormatFloat('0.0',xx); j := Trim(IntToStr(Round(xx*100))); if pos('.',j) <> 0 then j := Copy(j,1,pos('.',j)-1); if j = '' then j:='0'; if copy(j,length(j),1) = '0' then begin dxhj := '整'; zero := True; end else begin dxhj := ''; zero := False; end;
for i := 0 to Length(j)-1 do begin if StrToInt(Copy(j,Length(j)-i,1)) <> 0 then case i of 0: dxhj := '分'+dxhj; 1: dxhj := '角'+dxhj; 2: dxhj := '元'+dxhj; 3: dxhj := '拾'+dxhj; 4: dxhj := '佰'+dxhj; 5: dxhj := '仟'+dxhj; 6: dxhj := '万'+dxhj; 7: dxhj := '拾'+dxhj; 8: dxhj := '佰'+dxhj; 9: dxhj := '仟'+dxhj; 10: dxhj := '亿'+dxhj; 11: dxhj := '拾'+dxhj; end;
case StrToInt(Copy(j,Length(j)-i,1)) of 0: begin if not zero then dxhj := '零'+dxhj; zero := True; end; 1: begin dxhj := '壹'+dxhj; zero := False; end; 2: begin dxhj := '贰'+dxhj; zero := False; end; 3: begin dxhj := '叁'+dxhj; zero := False; end; 4: begin dxhj := '肆'+dxhj; zero := False; end; 5: begin dxhj := '五'+dxhj; zero := False; end; 6: begin dxhj := '六'+dxhj; zero := False; end; 7: begin dxhj := '七'+dxhj; zero := False; end; 8: begin dxhj := '八'+dxhj; zero := False; end; 9: begin dxhj := '玖'+dxhj; zero := False; end; end; end; if dxhj = '整' then dxhj := ''; Result := dxhj; end;
Result := Result + cNumberCn[StrToInt(S[I]) + 1] + cPointCn[P - I]
else if P = I then begin
Result := StringReplace(Result, '零十零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零百零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零千零', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零十', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零百', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零千', '零', [rfReplaceAll]);
Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
Result := StringReplace(Result, '零点', '点', [rfReplaceAll]);
end else if P < I then
Result := Result + cNumberCn[StrToInt(S[I]) + 1];
if Result[Length(Result)] = cPointCn[1] then
Result := Copy(Result, 1, Length(Result) - 1);
if Result[1] = cPointCn[1] then Result := cNumberCn[1] + Result;
if (Length(Result) > 1) and (Result[2] = cPointCn[2]) and
(Result[1] = cNumberCn[2]) then
Delete(Result, 1, 1);
end; { NumberCn }
function MoneyCn(mMoney: Real): WideString;
var
P: Integer;
begin
if mMoney = 0 then begin
Result := '无';
Exit; //www.delphitop.com
end;
Result := NumberCn(Round(mMoney * 100) / 100);
Result := StringReplace(Result, '一', '壹', [rfReplaceAll]);
Result := StringReplace(Result, '二', '贰', [rfReplaceAll]);
Result := StringReplace(Result, '三', '叁', [rfReplaceAll]);
Result := StringReplace(Result, '四', '肆', [rfReplaceAll]);
Result := StringReplace(Result, '五', '伍', [rfReplaceAll]);
Result := StringReplace(Result, '六', '陆', [rfReplaceAll]);
Result := StringReplace(Result, '七', '柒', [rfReplaceAll]);
Result := StringReplace(Result, '八', '捌', [rfReplaceAll]);
Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
Result := StringReplace(Result, '十', '拾', [rfReplaceAll]);
Result := StringReplace(Result, '百', '佰', [rfReplaceAll]);
Result := StringReplace(Result, '千', '仟', [rfReplaceAll]);
P := Pos('点', Result);
if P > 0 then begin
Insert('分', Result, P + 3);
Insert('角', Result, P + 2);
Result := StringReplace(Result, '点', '圆', [rfReplaceAll]);
Result := StringReplace(Result, '角分', '角', [rfReplaceAll]);
Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
Result := StringReplace(Result, '零角', '', [rfReplaceAll]);
Result := StringReplace(Result, '分角', '', [rfReplaceAll]);
if Copy(Result, 1, 2) = '零圆' then
Result := StringReplace(Result, '零圆', '', [rfReplaceAll]);
end else Result := Result + '圆整';
Result := '人民币' + Result;
end;
第四种方法给你个函数吧 function Tjfdy.SmallTOBig(small:real):string; var SmallMonth,BigMonth:string; wei1,qianwei1:string[2]; qianwei,dianweizhi,qian:integer; begin {------- 修改参数令值更精确 -------} {小数点后的位数,需要的话也可以改动该值} qianwei:=-2;
第六种方法给你一段很短的代码吧,好用,我用过的 function TForm1.xTOd(i:Real):string; const d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿'; var m,k:string; j:integer; begin k:=''; m:=floattostr(int(i*100)); for j:=length(m) downto 1 do k:=k+d[(strtoint(m[Length(m)-j+1])+1)*2-1]+ d[(strtoint(m[Length(m)-j+1])+1)*2]+d[(10+j)*2-1]+d[(10+j)*2]; xTOd:=k; end;
调用: procedure TForm1.Button1Click(Sender: TObject); var Sum:real; begin sum:=12.34; showmessage('人民币大写:'+xTOd(Sum)); end;
第七种方法function SmallTOBig(small:real):string; var SmallMonth,BigMonth:string; wei1,qianwei1:string[2]; wei,qianwei,dianweizhi,qian:integer; begin {------- 修改参数令值更精确 -------} {小数点后的位置,需要的话也可以改动-2值} qianwei:=-2; {转换成货币形式,需要的话小数点后加多几个零} Smallmonth:=formatfloat('0.00',small); {---------------------------------} dianweizhi :=pos('.',Smallmonth);{小数点的位置} {循环小写货币的每一位,从小写的右边位置到左边} for qian:=length(Smallmonth) downto 1 do begin {如果读到的不是小数点就继续} if qian<>dianweizhi then begin {位置上的数转换成大写} case strtoint(copy(Smallmonth,qian,1)) of 1:wei1:='壹'; 2:wei1:='贰'; 3:wei1:='叁'; 4:wei1:='肆'; 5:wei1:='伍'; 6:wei1:='陆'; 7:wei1:='柒'; 8:wei1:='捌'; 9:wei1:='玖'; 0:wei1:='零'; end; {判断大写位置,可以继续增大到real类型的最大值} case qianwei of -3:qianwei1:='厘'; -2:qianwei1:='分'; -1:qianwei1:='角'; 0 :qianwei1:='元'; 1 :qianwei1:='拾'; 2 :qianwei1:='佰'; 3 :qianwei1:='千'; 4 :qianwei1:='万'; 5 :qianwei1:='拾'; 6 :qianwei1:='佰'; 7 :qianwei1:='千'; 8 :qianwei1:='亿'; 9 :qianwei1:='十'; 10:qianwei1:='佰'; 11:qianwei1:='千'; end; inc(qianwei); BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额} end; end; SmallTOBig:=BigMonth; end;
第八种是小写转大写用Delphi编写人民币大小写转换程序 本文是大写==>>小写 要小写==>>大写请跟我联系! 在财务管理系统中,有时需要打印大写人民币数字,于是笔者编写了以下一些函数使这一需要得以满足,现介绍如下: 注:copy(2005-Jey-QQ:344430663)本程序在Delphi7、Winwin2000下调试通过。} function TForm1.shuzi(jey: string):string ; var i:integer; s,s1,s2:integer; ab:integer; a,b,s3,s4:string; begin i:=1; ab:=0; a:=''; b:='';s:=0;s1:=0;s2:=0;s3:='0';s4:='0'; while i<=length(jey) do begin ab:=strtoint(shuzi1(copy(jey,i,2))); if ab=10000000 then begin b:=copy(jey,i+2,length(jey)); a:=copy(jey,1,i-1)+'元'; end; i:=i+2; end; //end-- while if length(b)=0 then b:=jey; i:=1; while i<=length(b) do begin s1:=strtoint(shuzi1(copy(b,i,2))); if s1 in [0..9] then begin s:=s1; end else begin s:=s1*s; s3:=inttostr((s)+strtoint(s3)); s:=0; end; i:=i+2; end; //end-- while
i:=1;s:=0;s1:=0;s2:=0; while i<=length(a) do begin s1:=strtoint(shuzi1(copy(a,i,2))); if s1 in [0..9] then begin s:=s1; end else begin s:=s1*s; s4:=inttostr((s)+strtoint(s4)); s:=0; end; i:=i+2; end; //end-- while
if length(s4)>1 then result:=inttostr(strtoint(copy(s4,1,length(s4)-3))*10000+(strtoint(s3)div 1000)) else result:=inttostr(strtoint(s3)div 1000); if strtoint(copy(s3,length(s3)-1,1))<>0 then result:=result+'.'+copy(s3,length(s3)-2,2) else if strtoint(copy(s3,length(s3)-2,1))<>0 then result:=result+'.'+copy(s3,length(s3)-2,1);
end; //end-- begin
function TForm1.shuzi1(jey: string):string; var i:integer; s:integer; s1:string; shu1:array of string[2]; begin s1:='168'; i:=0; SetLength(shu1,17); shu1[16]:='万';shu1[15]:='仟'; shu1[14]:='佰'; shu1[13]:='拾'; shu1[12]:='元';shu1[11]:='角';shu1[10]:='分'; SHU1[0]:='零';SHU1[1]:='壹';SHU1[2]:='贰';SHU1[3]:='叁';SHU1[4]:='肆'; SHU1[5]:='伍';SHU1[6]:='陆';SHU1[7]:='柒';SHU1[8]:='捌';SHU1[9]:='玖'; for i:=0 to 16 do begin if jey<>shu1[i] then continue; s:=i; break; end; case s of 0:s1:='0'; 1:s1:='1'; 2:s1:='2'; 3:s1:='3'; 4:s1:='4'; 5:s1:='5'; 6:s1:='6'; 7:s1:='7'; 8:s1:='8'; 9:s1:='9'; 10:s1:='10'; 11:s1:='100'; 12:s1:='1000'; 13:s1:='10000'; 14:s1:='100000'; 15:s1:='1000000'; 16:s1:='10000000'; end; result:=s1; end;
第九种方法 Function NtoC(n0 :real) :String; Function IIF(b :boolean; s1,s2:string):string; begin //本函数在VFP和VB中均为系统内部函数 if b then IIF:=s1 else IIF:=s2; end; Const c = '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万'; var L,i,n, code :integer; Z :boolean; s, st,st1 :string; begin s :=FormatFloat( '0.00', n0); L :=Length(s); Z :=n0<1; For i:= 1 To L-3 do begin Val(Copy(s, L-i-2, 1), n, code); st:=IIf((n=0)And(Z Or (i=9)Or(i=5)Or(i=1)), '', Copy(c, n*2+1, 2)) + IIf((n=0)And((i<>9)And(i<>5)And(i<>1)Or Z And(i=1)),'',Copy(c,(i+13)*2-1,2)) + st; Z := (n=0); end; Z := False; For i:= 1 To 2 do begin Val(Copy(s, L-i+1, 1), n, code); st1:= IIf((n=0)And((i=1)Or(i=2)And(Z Or (n0<1))), '', Copy(c, n*2+1, 2)) + IIf((n>0), Copy(c,(i+11)*2-1, 2), IIf((i=2) Or Z, '', '整')) + st1; Z := (n=0); end; For i := 1 To Length(st) do If Copy(st, i, 4) = '亿万' Then Delete(st,i+2,2); NtoC := IIf( n0=0, '零圆整', st + st1); End;
function StrTran(const S, s1, s2: string): string; begin Result := StringReplace(S, s1, s2, [rfReplaceAll]); end; var S, dx: string; i, Len: Integer; begin if mmje < 0 then begin dx := '负'; mmje := -mmje; end; S := Format('%.0f', [mmje * 100]); Len := Length(S); for i := 1 to Len do dx := dx + Copy(s1, (Ord(S[i]) - Ord('0')) * 2 + 1, 2) + Copy(s2, (Len - i) * 2 + 1, 2); dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰', '零'), '零拾', '零'), '零角', '零'), '零分', '整'); dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零', '零'), '零亿', '亿'), '零万', '万'), '零元', '元'); if dx = '整' then Result := '零元整' else Result := StrTran(StrTran(dx, '亿万', '亿零'), '零整', '整'); end; ////////// procedure TJzpzEdit1.FormCreate(Sender: TObject); begin frxReport1.AddFunction('function MoneyCn(mmje: Double): String;','Myfunction','小写金额转大写的函数'); end; ////////// function TJzpzEdit1.frxReport1UserFunction(const MethodName: string; var Params: Variant): Variant; begin if UpperCase(MethodName) = UpperCase('MoneyCn') then Result := MoneyCn(Params[0]); end; ////////// 报表中调用方法 MoneyCn(50000000)
第十一种方法 10行搞定数字转换成大写金额//10行搞定数字转换成大写金额 //原创 渴死的鱼 hanlin2020@hotmail.com //改编 inRm inrm@263.net function NumToChar( n:Real): wideString; //可以到万亿,并可随便扩大 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;
AZero := False; AUpperNum := ''; AMoneyUnit := ''; result := ''; if NumBer < 0 then begin result := '负'; N := -NumBer; end else N := NumBer; Str(N: 16: 2, StrNumber);
for I := 1 to 16 do begin if StrNumber[I] <> ' ' then begin AMoneyUnit := MoneyUnit[I]; if StrNumber[I] = '0' then begin if AZero and (copy(result, Length(result) - 1, 2) = '零') then result := copy(result, 1, Length(result) - 2); case I of 1..4, 6..8, 10..12: begin // 万,仟,佰,拾 AUpperNum := '零'; AMoneyUnit := ''; end; 5, 9, 13: begin // 亿,万,元 if StrToFloat(StrNumber) < 1 then AMoneyUnit := ''; AUpperNum := ''; end; 15: begin // 角 if StrToFloat(StrNumber) < 1 then AUpperNum := '' else AUpperNum := '零'; AMoneyUnit := ''; end; 16: begin // 分 AUpperNum := ''; AMoneyUnit := ''; end; end; AZero := True; end else begin if StrNumber[I] = '.' then begin AUpperNum := ''; AMoneyUnit := ''; end else begin AZero := False; AUpperNum := UpperNum[StrToInt(StrNumber[I])]; end end; //www.delphitop.com result := result + (AUpperNum + AMoneyUnit) end; end; result := result + '整'; end;