首届 Delphi 编程竞赛结果揭晓！ (0分)

  • 主题发起人 主题发起人 yysun
  • 开始时间 开始时间
能加我为好友嘛我想认识你们，ＯＩＣＱ：８５２７０６３
 
向高手学习！
 
一个DLL,用来接收函数表达式和变量值,并返回函数值
如: result:= fun('sin(x)*exp(x)',0.1);

library fun;
uses
sharemem,
SysUtils,
StdCtrls,
math;
function rapidstrtofun(s:string;x:double):double;
var
posi:array[1..50]of integer;
data:array[1..50]ofdo
uble;
mulsign,plusign:array[1..50]of char;
muldev,addmin:array[1..50]of integer;
{point to the position of data,index of data}
n,n2,n3:integer;
len,i,j:integer;
s1:string;
begin
s:=lowercase(s);
len:=length(s);
if len=1 then
begin
if s='x' then
begin
result:=x;exit;
end;
result:=strtofloat(s);exit;
end;
n:=0;{number of operater=n2+n3}
n2:=0;{number of * and /}
n3:=0;{number of + and -}
{find out the operater}
for i:=2 to lendo
begin
case s of
'*':
begin
inc(n);inc(n2);mulsign[n2]:='*';muldev[n2]:=n;
posi[n]:=i;
end;
'/':
begin
inc(n);inc(n2);mulsign[n2]:='/';muldev[n2]:=n;
posi[n]:=i;
end;
'+':
if (s[i-1]<>'e')=true then
begin
inc(n);inc(n3);plusign[n3]:='+';addmin[n3]:=n;
posi[n]:=i;
end;
'-':
if (s[i-1]<>'e')=true then
begin
inc(n);inc(n3);plusign[n3]:='-';addmin[n3]:=n;
posi[n]:=i;
end;
end;
end;
{pick out the data}
if n=0 then
begin
result:=strtofloat(s);exit;
end;
s1:='';
for i:=1 to posi[1]-1do
begin
s1:=s1+s;
end;

if s1='x' then
data[1]:=x
else
if s1='-x' then
data[1]:=-x
else
data[1]:=strtofloat(s1);
for i:=1 to n-1do
begin
s1:='';
for j:=posi+1 to posi[i+1]-1do
begin
s1:=s1+s[j];
end;
if s1='x' then
data:=x
else
data[i+1]:=strtofloat(s1);
end;
s1:='';
for i:=posi[n]+1 to lendo
begin
s1:=s1+s;
end;
if s1='x' then
data[n+1]:=x
else
data[n+1]:=strtofloat(s1);
{calculate * and /}
for i:=1 to n2do
begin
if mulsign='*' then
data[muldev+1]:=data[muldev]*data[muldev+1]
else
data[muldev+1]:=data[muldev]/data[muldev+1];
end;
for i:=1 to n3-1do
begin
if plusign='+' then
data[addmin[1]]:=data[addmin[1]]+data[addmin[i+1]]
else
data[addmin[1]]:=data[addmin[1]]-data[addmin[i+1]];
end;
if n3=0 then
result:=data[n2+1]
else
result:=data[1]+data[n+1];
end;

function brackets(s:string;x:double):double;register;
var
s0,s1:string;
time:integer;
i,j,k,order,l0:integer;
med:double;
med1,value2:double;
value1:integer;
count:array[1..1000]of integer;
judge:boolean;
Label line1;
begin
line1: order:=pos('((',s);
if(order>0)then
begin
insert('1*',s,order+1);
goto line1;
end;
time:=0;
s0:=s;
judge:=false;
l0:=length(s);
for i:=1 to l0do
begin
if(s='(')then
time:=time+1;
end;
if(time=0)then
judge:=true;
if(time>0)then
begin
for i:=1 to timedo
begin
j:=0;
for order:=1 to l0do
begin
if((s[order]='(')=true)or((s[order]=')')=true)then
begin
j:=j+1;
count[j]:=order;
end;
end;
for k:=1 to j-1do
begin
if(((s[count[k]]='(')=true)and
((s[count[k+1]]=')')=true))then
begin
order:=count[k];
{keep the location of ( }
break;
end;
end;
if(order=1)then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s1:=floattostr(med);
s:=s0;
delete(s,count[k],count[k+1]-count[k]+1);
insert(s1,s,count[k]);
s0:=s;
l0:=length(s);
end
else
begin
if(((s[count[k]-1]='*')=true)or((s[count[k]-1]='/')=true)or
((s[count[k]-1]='+')=true)or((s[count[k]-1]='-')=true))then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
s1:=floattostr(med);
delete(s,count[k],count[k+1]-count[k]+1);
insert(s1,s,count[k]);
s0:=s;
l0:=length(s);
continue;
end;

if(s[count[k]-1]='p')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=exp(med);
s1:=floattostr(med);
s:=s0;
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;

if(s[count[k]-1]='g')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='l')then
begin
med:=Log10(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end
else
begin
if(s[count[k]-2]='t')then
begin
delete(s,count[k]-2,l0-count[k]+3);
if((s='')=false)then
begin
if(s[count[k]-3]='c')then
begin
med:=cotan(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
end
else
begin
med:=tan(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end;
end
else
begin
med:=tan(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end;
end;
end;
continue;
end;
if(s[count[k]-1]='^')then
begin
value1:=pos(',',s);
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,value1);
value2:=rapidstrtofun(s,x);
s:=s0;
delete(s,value1,l0-value1+1);
delete(s,1,count[k]);
med1:=rapidstrtofun(s,x);
med:=power(med1,value2);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-1,count[k+1]-count[k]+2);
insert(s1,s,count[k]-1);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='s')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=cos(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='h')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='s')then
begin
med:=cosh(med);
end
else
begin
med:=sinh(med);
end;
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-4,count[k+1]-count[k]+5);
insert(s1,s,count[k]-4);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='t')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=sqrt(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-4,count[k+1]-count[k]+5);
insert(s1,s,count[k]-4);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='r')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=sqr(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='n')then
begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='l')then
begin
med:=ln(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end
else
begin
med:=sin(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
end;
continue;
end;
end;
end;
brackets:=rapidstrtofun(s,x);
end;

if(judge=true)then
brackets:=rapidstrtofun(s,x);
end;
exports
brackets name 'fun';
begin
end.
那么长怎么看呀！

 
我希望，把这些代吗提供下载
 
希望能将这些经典代码提供下载，我们有个向高手学习的机会[:)]
 
怎么总会有人提下载的问题呢?
前面已经说过了嘛, 在这儿:
http://aiming.ynxx.com/DelphiBBS_650664.htm
 
呵呵，真爽，下了代码好好学习中……
 
不知道各位对于DELPHI的数据库连接有什么高见
 
哎呀， 梦里寻她千百度， 蓦然回首， 嘿嘿， 灯火阑珊处。
可以好好地一睹高手们的风采了(当然是在代码行间了：） )。
恩， T-shirt果然不错， 正面、背面、LOGO， 全都Cool毕了。尤其是背面喽，呵呵
但愿下次我能穿上它………… 8D
呃…………LOGO女人， 是有点夸张， Wu Wu Wu， 文化忒深， 有点晕……
 
㊣㊣㊣㊣㊣㊣㊣㊣㊣㊣㊣ ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣
㊣ ㊣㊣ ㊣㊣㊣㊣㊣㊣㊣
㊣ ㊣ ㊣ ㊣
㊣㊣ ㊣ ㊣㊣㊣ ㊣㊣㊣㊣㊣㊣㊣
㊣ ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣㊣㊣㊣ ㊣㊣㊣㊣㊣
㊣㊣ ㊣ ㊣ ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣㊣㊣㊣㊣
㊣ ㊣㊣ ㊣ ㊣
㊣ ㊣ ㊣㊣㊣㊣㊣
 
挺好呀，等我下了原代码在说了，
原代码下载中。。。。。。。。
 
真的是一个很好的活动啊
 
借宝地一用
TO 斑竹和所有高手：
帮我解决一个棘手的问题吧：有关XML的，可能和WINNT服务程序的运行机制也有些关系吧！
见：http://www.delphibbs.com/delphibbs/dispq.asp?lid=1336676
拜托大家一定要帮我解决这个问题啊！
 
能不能把代码系统的提供个地儿DOWN呀
 
非常感兴趣！！！
 
●●●●●●●●●●● ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣
㊣ ㊣㊣ ●●●●●●●
㊣ ㊣ ㊣ ㊣
㊣㊣ ㊣ ㊣㊣㊣ ●●●●●●●
㊣ ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣㊣㊣㊣ ㊣㊣㊣㊣㊣
㊣㊣ ㊣ ㊣ ㊣ ㊣ ㊣
㊣ ㊣ ㊣ ㊣㊣㊣㊣㊣
㊣ ㊣㊣ ㊣ ㊣
㊣ ㊣ ㊣㊣㊣㊣㊣
 
没劲，尽是小玩艺，中国人就只会写这些？我觉得丢人。。。
 
您必须登录或注册才可回复。

Similar threads

S
[教程]如果在 Delphi /C++ Builder 中调试单元初始化时的错误
回复
0
查看
1K
swish
S
S
[教程]栈上接口对象在匿名函数中的使用时请注意内存泄露问题
回复
0
查看
904
swish
S
D
[原]2016-11-30：发布OrangeUI 1.65
回复
0
查看
753
DelphiTeacher的专栏
D
D
[原]2016-11-30：发布OrangeUI 1.65
回复
0
查看
659
DelphiTeacher的专栏
D
D
[原]2016-11-30：发布OrangeUI 1.65
回复
0
查看
653
DelphiTeacher的专栏
D
后退
顶部