您的位置:首页 > 编程语言 > Delphi

[转]Delphi 12种大小写转换的方法

2020-02-17 07:49 453 查看

----------第一种方法----------

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;    

 

----------第三种方法----------

//数字转中文

function   NumberCn(mNumber:   Real):   WideString;   
  const   
  cPointCn:   WideString   =   '点十百千万十百千亿十百千';   
  cNumberCn:   WideString   =   '零一二三四五六七八九';   
var   
  I,   L,   P:   Integer;   
  S:   string;   
begin   
  Result   :=   '';   
  if   mNumber   =   0   then  

  begin   
    Result   :=   cNumberCn[1];     
  Exit;   
  end;   
    
  S   :=   FloatToStr(mNumber);    
  if   Pos('.',   S)   <=   0   then   S   :=   S   +   '.';   
  P   :=   Pos('.',   S);   
  L   :=   Length(S);   

  
  for   I   :=   1   to   L   do   
  if   P   >   I   then   
  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;   
    
  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;   
    
      {转换成货币形式,需要的话小数点后加多几个零}   
      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;  

 

----------第五种方法---------

Function   TFormFhdCw.XxToDx(const   hjnum:real):String;     
  var   Vstr,zzz,cc,cc1,Presult:string;   
    
  xxbb:array[1..12]of   string;   
    
  uppna:array[0..9]   of   string;   
    
  iCount,iZero,vPoint,vdtlno:integer;   
    
  begin   
    
  //*设置大写中文数字和相应单位数组*//   
    
  xxbb[1]:='亿';   
    
  xxbb[2]:='仟';   
    
  xxbb[3]:='佰';   
    
  xxbb[4]:='拾';   
    
  xxbb[5]:='万';   
    
  xxbb[6]:='仟';   
    
  xxbb[7]:='佰';   
    
  xxbb[8]:='拾';   
    
  xxbb[9]:='元';   
    
  xxbb[10]:='.';   
    
  xxbb[11]:='角';   
    
  xxbb[12]:='分';   
    
  uppna[0]:='零';   
    
  uppna[1]:='壹';   
    
  uppna[2]:='贰';   
    
  uppna[3]:='叁';   
    
  uppna[4]:='肆';   
    
  uppna[5]:='伍';   
    
  uppna[6]:='陆';   
    
  uppna[7]:='柒';   
    
  uppna[8]:='捌';   
    
  uppna[9]:='玖';   
    
  Str(hjnum:12:2,Vstr);   
    
  cc:='';   
    
  cc1:='';   
    
  zzz:='';   
    
  result:='';   
    
  presult:='';   
    
  iZero:=0;   
    
  vPoint:=0;   
    
  for   iCount:=1   to   10   do   
    
  begin   
    
  cc:=Vstr[iCount];   
    
  if   cc<>'   '   then   
    
  begin   
    
  zzz:=xxbb[iCount];   
    
  if   cc='0'   then   
    
  begin   
    
  if   iZero<1   then   //*对“零”进行判断*//   
    
  cc:='零'   
    
  else   
    
  cc:='';   
    
  if   iCount=5   then   //*对万位“零”的处理*//   
    
  if   copy(result,length(result)-1,2)='零'   then   
    
  result:=copy(result,1,length(result)-2)+xxbb[iCount]   
    
  +'零'   
    
  else   
    
  result:=result+xxbb[iCount];   
    
  cc1:=cc;   
    
  zzz:='';   
    
  iZero:=iZero+1;   
    
  end   
    
  else   
    
  begin   
    
  if   cc='.'   then   
    
  begin   
    
  cc:='';   
    
  if   (cc1='')   or   (cc1='零')   then   
    
  begin   
    
  Presult:=copy(result,1,Length(result)-2);   
    
  result:=Presult;   
    
  iZero:=15;   
    
  end;   
    
  if   iZero>=1   then   
    
  zzz:=xxbb[9]   
    
  else   
    
  zzz:='';   
    
  vPoint:=1;   
    
  end   
    
  else   
    
  begin   
    
  iZero:=0;   
    
  cc:=uppna[StrToInt(cc)];   
    
  end   
    
  end;   
    
  result:=result+(cc+zzz)   
    
  end;   
    
  end;   
    
  If   Vstr[11]='0'   then   //*对小数点后两位进行处理*//   
    
  begin   
    
  if   Vstr[12]<>'0'   then   
    
  begin   
    
  cc:='零';   
    
  result:=result+cc;   
    
  cc:=uppna[StrToInt(Vstr[12])];   
    
  result:=result+(uppna[0]+cc+xxbb[12]);   
    
  end   
    
  end   
    
  else   
    
  begin   
    
  if   iZero=15   then   
    
  begin   
    
  cc:='零';   
    
  result:=result+cc;   
    
  end;   
    
  cc:=uppna[StrToInt(Vstr[11])];   
    
  result:=result+(cc+xxbb[11]);   
    
  if   Vstr[12]<>'0'   then   
    
  begin   
    
  cc:=uppna[StrToInt(Vstr[12])];   
    
  result:=result+(cc+xxbb[12]);   
    
  end;   
    
  end;   
    
  result:=result+'正';   
    
  end;    

 

----------第六种方法----------

给你一段很短的代码吧,好用,我用过的   
  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;  

 

  第十种 FastReport 创建"人民币大小写转换"自定义函数

FastReport 3.23.12 创建"人民币大小写转换"自定义函数 

控件版本是:FastReport 3.23.12 Enterpise for d2006 (DeXter)

设置如下:

function TJzpzEdit1.MoneyCn(mmje: Double): string;
const
s1: string = '零壹贰叁肆伍陆柒捌玖';
s2: string = '分角元拾佰仟万拾佰仟亿拾佰仟万';

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;

    ----------第十二种方法----------

 

小写金额转换为大写

function MoneyToUpper(const NumBer: Double): string; 
var StrNumber, AUpperNum, AMoneyUnit: string; 
  UpperNum: array[0..9] of string; 
  MoneyUnit: array[1..16] of string; 
  I: Integer; 
  AZero: Boolean; 
  N: Double; 
begin 
  UpperNum[1] := '壹'; 
  UpperNum[2] := '贰'; 
  UpperNum[3] := '叁'; 
  UpperNum[4] := '肆'; 
  UpperNum[5] := '伍'; 
  UpperNum[6] := '陆'; 
  UpperNum[7] := '柒'; 
  UpperNum[8] := '捌'; 
  UpperNum[9] := '玖'; 

  MoneyUnit[1] := '万'; 
  MoneyUnit[2] := '仟'; 
  MoneyUnit[3] := '佰'; 
  MoneyUnit[4] := '拾'; 
  MoneyUnit[5] := '亿'; 
  MoneyUnit[6] := '仟'; 
  MoneyUnit[7] := '佰'; 
  MoneyUnit[8] := '拾'; 
  MoneyUnit[9] := '万'; 
  MoneyUnit[10] := '仟'; 
  MoneyUnit[11] := '佰'; 
  MoneyUnit[12] := '拾'; 
  MoneyUnit[13] := '元'; 
  MoneyUnit[14] := '.'; 
  MoneyUnit[15] := '角'; 
  MoneyUnit[16] := '分'; 

  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; 
      result := result + (AUpperNum + AMoneyUnit) 
    end; 
  end; 
  result := result + '整'; 
end;

转载于:https://www.cnblogs.com/K-R-/p/8574405.html

  • 点赞
  • 收藏
  • 分享
  • 文章举报
abdmo02428 发布了0 篇原创文章 · 获赞 0 · 访问量 228 私信 关注
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: