分享个Delphi人民币转大写的函数

RMB

 

 

 

 

 

 

 

 

开发到财务方面的东西,往往需要把数值转换成大写金额输出。

网上找了一圈都没发现完美的,尤其是在XE系列下。

发现这个写法还是比较满意的,特分享。


 

  
function THxsdj.UPRMB(val: Double): string; {人民币转大写函数}  
var  
  Dig, Dpos, retVal, retValjf: string;  
  IntPart: array [0 .. 9] of Integer;  
  Vtemp, Icount: Integer;  
  Vjf: Integer;  
  Lastzh: string;  
begin  
  Dig := '零壹贰叁肆伍陆柒捌玖';  
  Dpos := '元拾佰仟万拾佰仟亿拾佰仟万';  
  Icount := 0;  
  Vtemp := Round(val * 100); // Trunc(val);  
  Vtemp := Vtemp div 100;  
  Vjf := Round(val * 100) - Vtemp * 100;  
  while Vtemp > 0 do  
  begin  
    IntPart[Icount] := Vtemp mod 10;  
    Vtemp := Vtemp div 10;  
    Inc(Icount);  
  end;  
  Vtemp := 0;  
  while Icount > 0 do  
  begin  
    if IntPart[Icount - 1] <> 0 then  
    begin  
      if Vtemp > 0 then  
        retVal := retVal + copy(Dig, 1, 1);  
      retVal := retVal + copy(Dig, 1 + IntPart[Icount - 1] * 1, 1) +  
        copy(Dpos, 1 + (Icount - 1) * 1, 1);  
      Vtemp := 0;  
    end  
    else  
    begin  
      if (Icount = 1) or (Icount = 5) or (Icount = 9) or (Icount = 12) then  
        retVal := retVal + copy(Dpos, 1 + (Icount - 1) * 1, 1);  
      Inc(Vtemp);  
    end;  
    Dec(Icount);  
  end;  
  Dig := '零壹贰叁肆伍陆柒捌玖';  
  Dpos := '分角';  
  Icount := 0;  
  Vtemp := Vjf; // Trunc(val);  
  if Round((Vjf div 10) * 10) = Round((Vjf / 10) * 10) then  
    Lastzh := '整';  
  while Vtemp > 0 do  
  begin  
    IntPart[Icount] := Vtemp mod 10;  
    Vtemp := Vtemp div 10;  
    Inc(Icount);  
  end;  
  Vtemp := 0;  
  while Icount > 0 do  
  begin  
    if IntPart[Icount - 1] <> 0 then  
    begin  
      if Vtemp > 0 then  
        retValjf := retValjf + copy(Dig, 1, 1);  
      retValjf := retValjf + copy(Dig, 1 + IntPart[Icount - 1] * 1, 1) +  
        copy(Dpos, 1 + (Icount - 1) * 1, 1);  
      Vtemp := 0;  
    end  
    else  
    begin  
      Inc(Vtemp);  
    end;  
    Dec(Icount);  
  end;  
  Result := retVal + retValjf + Lastzh;  
end; 

 

分享到: