FastReport调用Delphi中的自定义函数(人民币大写金额)

人民币大写金额转换函数
function MoneyToCn(ANumberic: Real): 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 ANumberic < 0 then
  
begin
    dx :
= '';
    ANumberic :
= -ANumberic;
  
end;

  S :
= Format('%.0f', [ANumberic * 100]);
  Len :
= Length(S);
  
for i := 1 to Len do
  dx :
= dx + Copy(s1, (Ord(S[i]) - Ord('0')) * 2 + 12+ Copy(s2, (Len - i)* 2 + 12);

  dx :
= StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟'''), '零佰',''),'零拾'''), '零角'''), '零分'
    
'');
  dx :
= StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零'''), '零零',''),'零亿''亿'), '零万'''), '零元'
    
'');
  
if dx = '' then
    Result :
= '零元整'
  
else
    Result :
= StrTran(StrTran(dx, '亿万''亿零'), '零整''');
end;

在Create中向FastReprot添加函数
procedure Create(Sender: TObject);
begin
  frxReport1.AddFunction(
'function MoneyToCn(ANumberic: Real): String;','Myfunction','人民币大写金额转换函数');
end;

在FastReport用户函数事件中添加
function frxReport1UserFunction(const MethodName: string; var Params: Variant): Variant;
begin
  
if UpperCase(MethodName) = UpperCase('MoneyToCn'then
  Result :
= MoneyToCn(Params[0]);
end;
posted @ 2008-06-03 21:28  sonicit  阅读(3176)  评论(0编辑  收藏  举报