FastReport调用Delphi中的自定义函数(人民币大写金额)
人民币大写金额转换函数
在Create中向FastReprot添加函数
在FastReport用户函数事件中添加
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 + 1, 2) + Copy(s2, (Len - i)* 2 + 1, 2);
dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰','零'),'零拾', '零'), '零角', '零'), '零分',
'整');
dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零','零'),'零亿', '亿'), '零万', '万'), '零元',
'元');
if dx = '整' then
Result := '零元整'
else
Result := StrTran(StrTran(dx, '亿万', '亿零'), '零整', '整');
end;
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 + 1, 2) + Copy(s2, (Len - i)* 2 + 1, 2);
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;
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;
begin
if UpperCase(MethodName) = UpperCase('MoneyToCn') then
Result := MoneyToCn(Params[0]);
end;