哪里有金额的大小写转换程序？

Question

哪里有金额的大小写转换程序？能告诉我吗？谢谢

Answer 1

function SmallTOBig(small:real):string;var
  SmallMonth,BigMonth:string;
  wei1,qianwei1:string[2];
  qianwei,dianweizhi,qian:integer;
  pre0 :integer;
begin  {------- 修改参数令值更精确 -------}
  qianwei:=-2;{小数点后的位置，需要的话也可以改动-2值}
  Smallmonth:=formatfloat('0.00',small);{转换成货币形式，需要的话小数点后加多几个零}
  dianweizhi :=pos('.',Smallmonth);{小数点的位置}
  BigMonth := '';
  pre0 := 1;
  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;        case qianwei of{判断大写位置，可以继续增大到real类型的最大值}
        -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;
        if wei1='零' then
        begin
          if (BigMonth<>'') and (pre0 = 0) then
          begin
            if qianwei = 0 then
              BigMonth := qianwei1+BigMonth
            else
              BigMonth :=wei1+BigMonth;
          end;
          if (BigMonth='') and (pre0 = 0) then
            BigMonth :=qianwei1+'整';
          if  (qianwei mod 4 =0) and (qianwei>0)  then
            BigMonth := qianwei1+BigMonth;
          pre0 := 1;
        end
        else
        begin
          BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
          pre0 := 0;
        end;        inc(qianwei);
      end
      else
        pre0:=0;    if copy(BigMonth,length(BigMonth)-1,2)='元' then
       BigMonth:=BigMonth+'整' ;
    SmallTOBig:=BigMonth;
    end;end;

Answer 2

aidelphi:
我很想要，能给我发过来吗？
[email protected]

Answer 3

我们在编程的过程中，特别是开发和财务相关的应用程序的时候，几乎都会遇到要将阿拉伯数字(一般是货币金额)转换为中文大写的要求。也有一些转换程序，但大都不符合财务实际要求，比如最简单的：
function xd(xx:currency):string;　　var　　dx,ws:string;　　i,cd:integer;　　int:currency;　　begin　　int:=trunc((abs(xx)+0.005)*100); 　　{在“厘”上4舍5入后去掉小数点}　　cd:=length(currtostr(int));　　{取得数字的长度，跟据此长度即可判断位数}　　dx:='零壹贰叁肆伍陆柒捌玖';　　ws:='分角元拾佰仟万拾佰仟亿拾佰仟';　　{位数}　　Result:= ' ';　　i:=1;　　while i<=cd do　　begin　　Result:=Result+copy(dx,strtoint(copy(currtostr　　(int),i,1))*2+1,2); 　　{取数字的大写}　　Result:=Result+copy(ws,(cd-i)*2+1,2);　　{加上数字的位数} 　　i:=i+1;　　end　　end　　在这里输入xd(1234567.89)，返回“壹佰贰拾叁万肆仟伍佰陆拾柒元捌角玖分”，但它并不完美，例如xd(100)，返回的却是：壹佰零拾零元零角零分（应是壹佰元整），显然这不符合财务工作的实际要求。中文大写的特殊性关键在对“0”的处理上，我们编程的思路也是如此，程序中遇到0的时候并不能简单地用大写“零”来代替，要进行如下判断：是否是第一个零（即它的左边是否不为零）？如是第一个零，还要判断，它的后面是否全为零（这要分段判断：亿以上，万以上亿以下，元以上万以下，分以上元以下）？如不是，才能以大写零来代替；如果是就直接写上位数如万（例如：100000，就应是壹拾万，而不是壹拾零万）。另一方面如果它的后面不全为零，却有连续的零，也要注意（例如：1001，就应是壹仟零壹元，而不是壹仟零零壹元）。　　以下就是根据这一思路给出的程序（此程序最大可转换至千亿位，在实际工作中也应该足够了）：　　……　　while i<=cd do　　begin　　if copy(currtostr(int),i,1)<> '0' then　　begin　　Result:=Result+copy(dx,strtoint(copy(currtostr(int),i,1))*2+1,2);　　Result:=Result+copy(ws,(cd-i)*2+1,2);　　ling:=false;　　i:=i+1;　　end　　else if ling=false and (copy(currtostr(int),i,1)= '0' ) then 　　{遇到第一个0}　　begin　　if cd-i+1>10 then 　　{判断是否是亿以上}　　 begin　　 w:=0;　　 for q:=11 to cd-i+1 do　　 begin　　 w:=w+strtoint(copy(currtostr(int),cd-q+1,1));　　 end ;　　if w=0 then 　　{整亿，即亿位有0或连续的0}　　 begin　　 Result:=Result+'亿';　　 i:=cd-9;　　 end 　　else 　　{非整亿，即亿位无0}　　 begin　　 Result:=Result+'零';　　 i:=i+1;　　 ling:=true;　　 end;　　 end　　else if cd-i+1>6 then 　　{判断是否是万以上}　　…… 　　{判断是否是元以上}　　 …… 　　{判断是否是分以上}　　 begin　　 w:=0;　　 for q:=1 to cd-i+1 do　　 begin　　 w:=w+strtoint(copy(currtostr(int),cd-q+1,1));　　 end ;　　 if w=0 then　　 begin　　 Result:=Result+'整';　　 i:=cd+1 ;　　 end　　 else　　 begin　　 Result:=Result+'零';　　 i:=i+1;　　 ling:=true;　　 end;　　 end;　　end　　else if (copy(currtostr(int),i,1)= '0') and (ling=true) then 　　{遇到一个连续的0,跳过}　　begin　　i:=i+1;　　end;　　end;　　if xx<0 then Result:= '负'+Result;　　{判断是否为负数}　　end;　　以上程序在Windows 2000(Windows 98)+Delphi 6中调试通过。

Answer 4

也许不用那么麻烦，试试这个函数，把小写转成大写金额function TForm1.xTOd(i:Real):string;
const
  d='零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
var
  m,k:string; 
  j:integer;
  tmp : integer;
begin 
  k:='';
  m:=floattostr(int(i*100));
  j := length(m);
  tmp :=  (strtoint(m[Length(m)-j+1])+1)*2-1;
  showmessage(d[(10+j)*2-1]+d[(10+j)*2]);
  showmessage(d[(strtoint(m[Length(m)-j+1])+1)*2-1]);
  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;

Answer 5

nx_lsj，我发了，请查收，收不到再发信息给我。记得给我加高分哦！

Answer 6

alusa(alusa) 的方法比较简洁，但如果数额超过10亿会出问题，如果你的数额在10亿之内，可以使用该方法，或着改写一下也行

Answer 7

sysu(死树) 的方法完善一些，四舍五入（保留到分），有“整”字样，但如果数额超过10000亿会出问题，如果你的数额在10000亿之内，可以使用该方法，或着改写一下也行