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

人民币大写金额转换函数

 1 function MoneyToCn(ANumberic: Real): string;
 2 const
 3   s1: string = '零壹贰叁肆伍陆柒捌玖';
 4   s2: string = '分角元拾佰仟万拾佰仟亿拾佰仟万';
 5 
 6 function StrTran(const S, s1, s2: string): string;
 7 begin
 8   Result := StringReplace(S, s1, s2, [rfReplaceAll]);
 9 end;
10 var
11   S, dx: string;
12   i, Len: Integer;
13 
14 begin
15   if ANumberic < 0 then
16   begin
17     dx := '负';
18     ANumberic := -ANumberic;
19   end;
20 
21   S := Format('%.0f', [ANumberic * 100]);
22   Len := Length(S);
23   for i := 1 to Len do
24   dx := dx + Copy(s1, (Ord(S[i]) - Ord('0')) * 2 + 1, 2) + Copy(s2, (Len - i)* 2 + 1, 2);
25 
26   dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰','零'),'零拾', '零'), '零角', '零'), '零分', 
27     '整');
28   dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零','零'),'零亿', '亿'), '零万', '万'), '零元', 
29     '元');
30   if dx = '整' then
31     Result := '零元整'
32   else
33     Result := StrTran(StrTran(dx, '亿万', '亿零'), '零整', '整');
34 end;

在Create中向FastReprot添加函数

1 procedure Create(Sender: TObject);
2 begin
3   frxReport1.AddFunction('function MoneyToCn(ANumberic: Real): String;','Myfunction','人民币大写金额转换函数');
4 end;

在FastReport用户函数事件中添加

1 function frxReport1UserFunction(const MethodName: string; var Params: Variant): Variant;
2 begin
3   if UpperCase(MethodName) = UpperCase('MoneyToCn') then
4   Result := MoneyToCn(Params[0]);
5 end;

 

posted @ 2025-01-20 15:47  Thenext  阅读(47)  评论(0)    收藏  举报