有关FastReport中的自定义函数,请指教。 (各位行行好。救救我吧) (20分)

  • 主题发起人 风雨燕归来
  • 开始时间

风雨燕归来

Unregistered / Unconfirmed
GUEST, unregistred user!
这是一个在fastreport中自定义一个金额小写转大写的问题,如下:
(你别看了简单就跑,关键是如何有fastreport连接)
function TGzb.Currency(rmb:real):string;
var s1,s2,s3,s4,dxs:string;
l,l1,l2,l3:integer;
begin
s1:='分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟万';
s2:='零壹贰叁肆伍陆柒捌玖';
l:=length(floattostr(rmb));
if copy(floattostr(rmb),l-2,1)='.' then
begin
dxs:=floattostr(abs(rmb));
end
else
begin
if copy(floattostr(rmb),l-1,1)='.' then
dxs:=floattostr(abs(rmb))+'0'
else
dxs:=floattostr(abs(rmb))+'.00'
end;
l1:=length(dxs);
dxs:=copy(dxs,1,l1-3)+copy(dxs,l1-1,2);
s3:='';
l2:=length(dxs);
l3:=0;
while l2>0do
begin
s3:=copy(s1,l3*2+1,2)+s3;
s3:=copy(s2,strtoint(copy(dxs,l2,1))*2+1,2)+s3;
l2:=l2-1;
l3:=l3+1;
end;
s4:='';
l2:=1;
while l2<length(s3)do
begin
if copy(s3,l2,2)='零' then
begin
if copy(s3,l2+2,2)='万' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'万'
else
s4:=s4+'万';
end;
if copy(s3,l2+2,2)='圆' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'圆'
else
s4:=s4+'圆';
end;
if copy(s3,l2+2,2)='亿' then
begin
if copy(s4,length(s4)-1,2)='零' then
s4:=copy(s4,1,length(s4)-2)+'亿'
else
s4:=s4+'亿';
end;
if copy(s4,length(s4)-1,2)<>'零' then
s4:=s4+'零';
end
else
s4:=s4+copy(s3,l2,4);
l2:=l2+4;
end;
if copy(s4,length(s4)-3,4)='圆零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-3,4)='角零' then
begin
s4:=copy(s4,1,length(s4)-2)+'整';
end;
if copy(s4,length(s4)-1,2)='零' then
begin
s4:=copy(s4,1,length(s4)-2)+'圆整';
end;
result:=s4;
end;

//将以上函数转为fastreport的自定义函数。
procedure TGzb.frReport1UserFunction(const Name: String;
p1, p2,
p3: Variant;
var Val: Variant);
begin
// try
if AnsiCompareText('NumtoRmb', Name) = 0 then
val := currency(p1);
// except
// end;
end;

1 .结果总是提示:被转化的字段是一个无效的浮点值。
([xxxx] is not a valid floating point value)
2 .把function TGzb.Currency(rmb:real):string;换成为:
function TGzb.Currency(rmb:string):string;(接口函数等都作了改变)
但又提示:不能由string转为double值。
晕。。。。。。。。。。。。。。。。。。。。。。。。。。。。。
我想了整整一个晚上了,好心的大富翁们,帮帮我吧。
是从晚上22:00-6:00哪。没分了,给20分吧。

 
兄弟姐妹们,怎么没有人来看我的贴子呢?
 
正好我以前也寫過這樣的函數,請指正:
function TForm1.small2big(money:real):String;
var
smallmode:string;
bigchar,powerchar:string[2];
power,dotpos,i:integer;
begin
//變量power用來記錄當前正在轉換的字符的權值
power:=-3;
//將浮點型金額格式化成字符串smallmode,小數點后至少保持兩位數
smallmode:=formatFloat('0.00',money);
//獲取小數點在字符串中的位置
//在pos函數前加一個前綴system是為了避免編譯時的函數沖突
dotpos:=system.pos('.',smallmode);
//從字符串smallmode右端開始依次轉換字符
for i:=length(smallmode)do
wnto 1do
begin
//遇到小數點則不用轉換
if i=dotpos then
continue;
//把字符串最右端的字符作為當前字符串并把它轉換成整數
case strToint(copy(smallmode,i,1)) of
//根據這個數值把0-9轉換成相應的大寫字符
//由于一個漢字需要兩個字節來存儲,因此bigchar是由兩個字節字符數組變量
1:bigchar:='壹';
2:bigchar:='貳';
3:bigchar:='參';
4:bigchar:='肆';
5:bigchar:='伍';
6:bigchar:='陸';
7:bigchar:='柒';
8:bigchar:='捌';
9:bigchar:='玫';
0:bigchar:='零';
end;
//根據權值確定相應的金額單位名稱
case power of
-3:powerchar:='厘';
-2:powerchar:='分';
-1:powerchar:='角';
0:powerchar:='元';
//"拾"將可能重復出現在1,5,9位上
1,5,9:powerchar:='拾';
2,6,10:powerchar:='佰';
3,7,11:powerchar:='仟';
4,12:powerchar:='萬';
8:powerchar:='億';
end;
//將權值提高一位
inc(power);
result:=bigchar+powerchar+result;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit2.text:=small2big(strtoFloat(edit1.text));
//如 edit1.text:='123456789.123';
//那么 edit2.text將顯示'壹仟貳佰參拾肆萬伍仟陸佰柒拾捌元玫角壹分貳厘'
end;
 
不是那个转换函数有问题,是那个自定义的转换接口有问题。
1、比如我在报表中这么定义
numtormb(1000),则结果正确,能返回"壹仟元整"字样。
numtormb(某一单晶度字段),就是提示出错。
2、如果我把
Currency(rmb:real):string改写成:
begin
result := 'xxxxxxxxxxxxxxx';
//就是随意返回一个字符串了。
end
在报表中如此调用
numtormb(某一单晶度字段),也不会出错,能正确返回xxxxxxxxxx这个字符串。
综合以上两种情况,请问这是怎么一回事呀?
 
楼主有点多此一举了吧,
网上有一个FastReport的增强单元,
给FastReport增加了许多的内建函数,其中就包括你需要的这个函数
你只需要在报表的表达式中调用这个函数就可以了,
如果你需要这个单元,留下email,我发给你
 
顺便问一下,你的FastReport的版本是多少的?
 
真的吗?谢谢。
fengxiaobao@sohu.com
请写明标题。
 
2.5中文版。
 
我都没有用过FastReport,不敢多说!不过以后还请楼住多多指教
FastReport。
 
变通一下,别用自定义函数了,直接在打印按钮的代码中写 frReport1.FindObject('MemoXX').Memo.Text:=大小写转换函数()。
 
to blyb:
可俺还是想用自定义函数。
MemoXX是自定义生成的,不好办。
 
没用过 fastreport自定义函数功能啊。。。
不过平时对于货币,都是用 currency 类型变量的
 
http://www.playicq.com/dispdocnew.php?id=8663
资源名称:FastReport 附加自定义函数库
把fr_AddinFunc加入到fastreport的包中重新编译即可。
可惜我现在下载不了,你自己下载吧
 
如果你有增强版的,里面也有相关的函数,但好像不全
我以前下载的有,但是跳槽了,就全丢了
 
[:(] to lich:
它是要钱的。
 
ftp://new1:f54dce3@61.129.70.192/control/2003090714503823497.pas
这个地址: FastReport 附加自定义函数库
我下载不了,你自己试试吧
 
各位兄弟姐妹:
最好是你们能把代码,测试一下,真的很奇,亦或是我蠢的比较可以。总之帮一个忙嘛。
 
to lich:
这么帮忙,很是感谢,但还是下载不了。
 
将function TGzb.Currency(rmb:real):string;
改成
function TGzb.Currency(rmb:currency):string;
 
给你一个:
function TFdm.jd(var s:string;var n:integer):string;//截断字符串
begin
n:=n+1;
if length(trim(s))<=4 then
begin
result:=trim(s);
s:='';
end
else
begin
result:=copy(s,length(s)-3,4);
delete(s,length(s)-3,4);
end;
end;

function TFdm.zszh(var s:string;n:integer):string;//整数转换
var
cd,i:integer;//字符长度,循环变量
qsdx,qsdw,fh,szf,zjdw:string;
//钱数大写,钱数单位,返回,首字符,中间单位
begin
cd:=length(s);
fh:='';szf:='';
for i:=cddo
wnto 1do
begin
case strtoint(copy(s,i,1)) of //位置上的数转换成大写
1:qsdx:='壹';
2:qsdx:='贰';
3:qsdx:='叁';
4:qsdx:='肆';
5:qsdx:='伍';
6:qsdx:='陆';
7:qsdx:='柒';
8:qsdx:='捌';
9:qsdx:='玖';
0:qsdx:='零';
end;
case cd-i of //判断大写位置,可以继续增大到real类型的最大值
0 :qsdw:='';
1 :qsdw:='拾';
2 :qsdw:='佰';
3 :qsdw:='千';
end;
if ((szf='')or(szf='零'))and(qsdx='零') then
begin
qsdx:='';qsdw:='';
end;
//if (szf<>'')and(qsdx='零') then
if (szf<>'')and(szf<>'零')and(qsdx='零')and(qsdx<>'') then
begin
qsdx:='零';qsdw:='';
end;
fh:=qsdx+qsdw+fh;
szf:=copy(fh,1,2);
end;
case n of
1:zjdw:='元';
2:zjdw:='万';
3:zjdw:='亿';
4:zjdw:='万';
end;
if (fh='')and(n<>1)and(n<>3) then
zjdw:='';
result:=fh+zjdw;
end;

function TFdm.dicimaltoint(small:Currency):string;
var
s,zs,xs,fhzs,fhxs,qsdx,qsdw:string;//整数,小数,返回整数,返回小数,钱数大写,钱数单位
i,cd:integer;
//循环变量,字符串长度,零计数
begin
fhzs:='';fhxs:='';
if small=0 then
result:='零元'
else
begin
zs:=floattostr(int(small));
xs:=floattostr(round(frac(small)*100+0.000001));
if zs='0' then
fhzs:=''
else
begin
i:=0;
while length(zs)>0do
begin
s:=jd(zs,i);
if (i<>1)and(copy(s,length(s),1)='0')and(copy(fhzs,1,2)<>'零') then
fhzs:=zszh(s,i)+'零'+fhzs
else
fhzs:=zszh(s,i)+fhzs;
end;
end;
if xs='0' then
fhxs:=''
else
begin
cd:=length(xs);
for i:=cddo
wnto 1do
begin
case strtoint(copy(xs,i,1)) of
1:qsdx:='壹';
2:qsdx:='贰';
3:qsdx:='叁';
4:qsdx:='肆';
5:qsdx:='伍';
6:qsdx:='陆';
7:qsdx:='柒';
8:qsdx:='捌';
9:qsdx:='玖';
0:qsdx:='零';
end;
case cd-i of
0:qsdw:='分';
1:qsdw:='角';
end;
if (cd=1)and(zs<>'0') then
//如果没有角(cd=1),而整数由不为零,则整数与小数中间加零
fhxs:='零'+qsdx+qsdw+fhxs
else
fhxs:=qsdx+qsdw+fhxs;
end;
end;
result:=fhzs+fhxs;
end;
end;
 
顶部