FastReport问题整理(技巧) 之二

所有内容来源于网络：

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

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, frxClass, frxDesgn;

type
  TForm1 = class(TForm)
    Button1: TButton;
    frxReport1: TfrxReport;
    frxDesigner1: TfrxDesigner;
    procedure Button1Click(Sender: TObject);
    function frxReport1UserFunction(const MethodName: String;
      var Params: Variant): Variant;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  frxReport1.DesignReport;
end;

function TForm1.frxReport1UserFunction(const MethodName: String;
  var Params: Variant): Variant;
begin
  if UpperCase(MethodName) = UpperCase('MoneyToCn') then
    Result := MoneyToCn(Params[0]);
end;

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

end.

<测试验证通过>