谁有将货币数字转化成中文大写格式的函数?

Question

Function SmallToBig(Number:string):String;
var
    numberunit: array[1..16] of string;{单位数组}
    numbervalue: array[1..10] of string;{数字数组}
    number2:string;{角分数串}
    number1:string;{元以上数串}
    numbertmp:string;{临时数串}
    i:integer; {循环变量}
    flag:integer;{角元分隔}
    zeroflag:integer;{本位零标志 0：本位不为零 1：本位为零}
    fzeroflag:integer;{低位是否有非零数标志 0：低位无非零数 1：低位有非零数}
    ooflag:integer;{最高位是否为零标志 0：最高位为零 1：最高位不为零}
    resulttotal:string;{总结果串}
    result1:string;{元以上结果串}
    result2:string;{角分结果串}
Begin
    numberunit[2] :='分';
    numberunit[1] :='角';
    numberunit[3] :='元';
    numberunit[4] :='拾';
    numberunit[5] :='佰';
    numberunit[6] :='仟';
    numberunit[7] :='万';
    numberunit[8] :='拾';
    numberunit[9] :='佰';
    numberunit[10] :='仟';
    numberunit[11] :='亿';
    numberunit[12] :='拾';
    numberunit[13] :='佰';
    numberunit[14] :='仟';
    numberunit[15] :='万';
    numberunit[16] :='亿';
    numbervalue[1] :='零';
    numbervalue[2] :='壹';
    numbervalue[3] :='贰';
    numbervalue[4] :='叁';
    numbervalue[5] :='肆';
    numbervalue[6] :='伍';
    numbervalue[7] :='陆';
    numbervalue[8] :='柒';
    numbervalue[9] :='捌';
    numbervalue[10] :='玖';
    number2 :='';
    number1 :='';
    {分解角分元数串}
    flag:=1;
    for i:=1 to length(number) do
    begin
    if number[i]='.' then Flag :=2;
      if flag=1 then number1:=number1+number[i]
        else
          if number[i]<>'.' then number2 := number2+number[i];
    end;
    {除高位零}
    numbertmp := number1;
    number1 := '';
    ooflag := 0;
    for i:=1 to length(numbertmp) do
      begin
      if (numbertmp[i]<>'0') then ooflag:=1;
      if ooflag=1 then number1:=number1+numbertmp[i];
      end;
      {最大值为亿亿元}
    if length(number1)>14 then
      begin
      showmessage('numbercnv out of range!');
      SmallToBig:='';
      end;    {组织元以上结果串}
    result1:='';
    zeroflag:=0;
    Fzeroflag:=1;
    for i:=length(number1) downto 1 do
      begin
      if (i=length(number1)) and (strtoint(number1[i])=0) then{个位为零时}
        begin
        fzeroflag:=0;
        zeroflag:=1;
        result1:='元';
        end
      else
      if (i<length(number1)) and (strtoint(number1[i])=0) then{中间零处理}
        begin
          if (length(number1)-i=4) or (length(number1)-i=8) then{万与亿位设定}
              begin
              if (length(number1)-i=4) and (length(number1)>=8) then
              begin
              if NOT((length(number1)-i=4)and(strtoint(number1[i])=0)
                and(strtoint(number1[i-1])=0) and(strtoint(number1[i-2])=0)
                and(strtoint(number1[i-3])=0)) then
              result1:=numberunit[length(number1)-i+3]+result1;
              end
              else
                result1:=numberunit[length(number1)-i+3]+result1;
              fzeroflag:=0;
              end;
        if fzeroflag=1 then{中间零设置}
            if zeroflag=0 then
              result1:=numbervalue[strtoint(number1[i])+1]+result1;
          zeroflag:=1;
        end
        else{非零数处理}
        begin
        fzeroflag:=1;
        zeroflag:=0;
          result1:=numberunit[length(number1)-i+3]+result1;
          result1:=numbervalue[strtoint(number1[i])+1]+result1;
        end;
      end;
      {组织角分结果串}
      result2:='';
      for i:=1 to length(number2) do
      begin
      if i<3 then
        begin
        if strtoint(number2[i])<>0 then
          begin
        result2:=result2+numbervalue[strtoint(number2[i])+1];
        result2:=result2+numberunit[i];
          end;
        end;
      end;
      ResultTotal := Result1+Result2;
      SmallToBig := ResultTotal;
End;

Answer 1

function Tform1.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;

Answer 2

http://www.csdn.net/expert/topic/565/565492.xml?temp=7.094973E-02都是从这个贴子上来的；

Answer 3

http://www.csdn.net/expert/topic/564/564806.xml?temp=3.966922E-02还有这个

Answer 4

我正是引用了Cobi前辈的代码。我正好也在往我程序中copy这段代码，还留在剪贴版中，顺手就copy上来了，这就是资源共享。

Answer 5

Function NumberToChinese(Number:Currency):String;//Stdcall;
var iNumLength:Integer;//数字长度
    i,k:Integer;
    sNumber:String;
    arChinseUnit:Array [0..13] of String;
    arALB:Array [0..9] of String;
    bZeroFlag,bHasUnit:Boolean;
begin
  arChinseUnit[0]  :='分';  arChinseUnit[1]  :='角';  arChinseUnit[2]  :='元';
  arChinseUnit[3]  :='拾';  arChinseUnit[4]  :='佰';  arChinseUnit[5]  :='仟';
  arChinseUnit[6]  :='万';  arChinseUnit[7]  :='拾';  arChinseUnit[8]  :='佰';
  arChinseUnit[9]  :='仟';  arChinseUnit[10] :='亿';  arChinseUnit[11] :='拾';
  arChinseUnit[12] :='佰';  arChinseUnit[13] :='仟';
  arALB[0]:='零';  arALB[1]:='壹';  arALB[2]:='贰';  arALB[3]:='叁';  arALB[4]:='肆';
  arALB[5]:='伍';  arALB[6]:='陆';  arALB[7]:='柒';  arALB[8]:='捌';  arALB[9]:='玖';  Try
    sNumber:=Trim(FloatToStr(Abs(Number)));
  Except
    Result:='转换出错!';
    Exit;
  end;
  i:=Pos('.',sNumber);
  iNumLength:=StrLen(PChar(sNumber));
  if (iNumLength-i>13) or (i>13) then begin //整数超过14位
    Result:='数字太大，无法转换!';
    Exit;
  end;  //将数字制作成0.00的式样
  if ( ( (iNumLength-i)>=3 ) and (i>0) ) then    //处理小数点后大于2位的情况
     sNumber:=Copy(sNumber,1,i+2);
  if ( ( (iNumLength-i)=1 ) and (i>0) ) then    //处理小数点后只有一位的情况补足零
     sNumber:=sNumber+'0';
  if i=0 then                               //处理无小数的情况,无小数点
     sNumber:=sNumber+'.00';
  if i=iNumLength then                      //处理无小数的情况,有小数点
     sNumber:=sNumber+'00';  //裁去小数点
  i:=Pos('.',sNumber);
  sNumber:=Copy(sNumber,1,i-1)+Copy(sNumber,i+1,2);  iNumLength:=StrLen(PChar(sNumber));
  bZeroFlag:=False;
  bHasUnit:=False;
  Result:='';
  For I:=1 to iNumLength do begin   //处理整数部分
    //处理当前位
    k:=StrToInt(Copy(sNumber,i,1));    //当前位大于0
    if k<>0 then begin
      //当前位已经有位标志如佰
      bHasUnit:=False;
      //之前的数字是否需要0如叁仟零壹
      if bZeroFlag then begin
        Result:=Result+'零'+arALB[k]+arChinseUnit[iNumLength-i];
        bZeroFlag:=False;
      end else //end if bZeroFlag
        Result:=Result+arALB[k]+arChinseUnit[iNumLength-i];
    end;    if k=0 then begin
      if ( (arChinseUnit[iNumLength-i]<>'角') and (arChinseUnit[iNumLength-i]<>'拾')
               and (arChinseUnit[iNumLength-i]<>'佰')
               and (arChinseUnit[iNumLength-i]<>'仟')) then
        if not bHasUnit then begin
          Result:=Result+arChinseUnit[iNumLength-i];
          bHasUnit:=True;
        end;   //end if not bHasUnit
      bZeroFlag:=True;      //如果元前有零且金额小于一元(实际情况为0.1 ...);
      if (arChinseUnit[iNumLength-i]='元') and (Number<1) then
        bZeroFlag:=False;
    end;//end k=0  end;//end for  //处理小数部分的最后一位
  k:=StrToInt(Copy(sNumber,iNumLength,1));
  if k=0 then
    if Copy(Result,Length(Result)-1,2)='元' then
      Result:=Result+'整'
    else
      Result:=Copy(Result,1,Length(Result)-2)+'整';  if ((Length(sNumber)=3) and (StrToInt(sNumber)<100)) then
    Result:=Copy(Result,3,Length(Result)-2);  if ((Length(sNumber)=3) and (StrToInt(sNumber)<10)) then
    Result:=Copy(Result,3,Length(Result)-2);
  if Number<0 then
    Result:='币:负'+Result
  else
    Result:='币:'+Result;
end;

Answer 6

function chartostring(char1:char):string;
begin
  case char1 of
    '0':  result:='零';
    '1':  result:='壹';
    '2':  result:='贰';
    '3':  result:='叁';
    '4':  result:='肆';
    '5':  result:='伍';
    '6':  result:='陆';
    '7':  result:='柒';
    '8':  result:='捌';
    '9':  result:='玖';
  end;
end;

Answer 7

ihihonline(小小) :再仔细查一下，http://www.csdn.net/expert/topic/565/565492.xml?temp=7.094973E-02 这个帖子本来就是我贴的呀：）