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 <0then begin dx :='负'; ANumberic :=-ANumberic; end; S := Format('%.0f', [ANumberic *100]); Len := Length(S); for i :=1to 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;
在FastReport用户函数事件中添加
function frxReport1UserFunction(const MethodName: string; var Params: Variant): Variant; begin if UpperCase(MethodName) = UpperCase('MoneyToCn') then Result := MoneyToCn(Params[0]); end;