导航

//以下函数能将小于十万亿元的小写金额转换为大写
//作者 方小庆(inrm@263.net)
Function NtoC(n0 :real) :wideString;stdcall;
Function IIF(b :boolean; s1,s2:string):string;
begin //本函数在VFP和VB中均为系统内部函数
if b then IIF:=s1 else IIF:=s2;
end;
Const c = '零壹贰叁肆伍陆柒捌玖◇分角圆拾佰仟万拾佰仟亿拾佰仟万';
var L,i,n, code :integer;
Z :boolean;
s, st,st1 :string;
begin
s :=FormatFloat( '0.00', n0);
L :=Length(s);
Z :=n0<1;
For i:= 1 To L-3 do
begin
Val(Copy(s, L-i-2, 1), n, code);
st:=IIf((n=0)And(Z Or (i=9)Or(i=5)Or(i=1)), '', Copy(c, n*2+1, 2))
+ IIf((n=0)And((i<>9)And(i<>5)And(i<>1)Or Z And(i=1)),'',Copy(c,(i+13)*2-1,2))
+ st;
Z := (n=0);
end;
Z := False;
For i:= 1 To 2 do
begin
Val(Copy(s, L-i+1, 1), n, code);
st1:= IIf((n=0)And((i=1)Or(i=2)And(Z Or (n0<1))), '', Copy(c, n*2+1, 2))
+ IIf((n>0), Copy(c,(i+11)*2-1, 2), IIf((i=2) Or Z, '', '整'))
+ st1;
Z := (n=0);
end;
For i := 1 To Length(st) do If Copy(st, i, 4) = '亿万' Then Delete(st,i+2,2);
NtoC := IIf( n0=0, '零', st + st1);
End;

////////////////////////

function TForm2.frxpt1UserFunction(const MethodName: String;
var Params: Variant): Variant;
begin
if UpperCase(MethodName) = UpperCase('F2C') then
Result := f2c(Params[0]);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
frxpt1.AddFunction('function F2C(n0: real): String;','Myfunction','小写金额转大写的函数');
end;