有点复杂的算法问题哦，是关于计算公式的。

Question

如果我有一个字符串 jsgs:='x*y+z*(4+3)'，另外变量 x:=100.45,y:=24.23,
 z:=34.3 等，我该怎么利用这个计算公式来求出值来呢。另外，我想这种问题恐怕还得考虑相关的计算优先级哦。我感觉好像要用以前数据结构学的二叉树，呵呵，只是都还给老师了。

Answer 1

Component - Install Activex -
Microsoft Script Control 1.0ScriptControl1.Language := 'JScript';
showmessage(ScriptControl1.Eval('var  x=100.45,y=24.23,z=34.3 ; x*y+z*(4+3);'));

Answer 2

可以用stringReplace来实现?能否具体的说说啊。我想，如用stringreplace取出的仍然是字符串啊，只不过是把变量的数值放进去了，我怎么能得出结果呢？

Answer 3

unit Z_parser;interface
uses sysutils,stdctrls,classes;TYPE
EparserError=class(Exception);
Rparameters= record x,y,z:extended; end;
Const parameter:Rparameters=(x:1;y:1;z:1);
TYPETZMathEdit=class(TEdit)
private
  function getEvaluatedString:string;
public
  property TextValue:string read getEvaluatedString;
end;function EvaluateToFloat(s0:string):extended;
Function GetEvaluationError:string;
//procedure Register;implementation
const  sopps:string=('+-*/^');
var EvaluationError:string;{procedure Register;
begin
  RegisterComponents('Samples', [TZMathEdit]);
end;}
function evaluate(s0:string):extended;forward;procedure matchbracket(var i:integer;s0:string);
   var j,len:integer;
begin j:=1;len:=length(s0);
      repeat inc(i);
             if i>len then raise EparserError.Create('missing '')''');
             if s0[i]='(' then inc(j);
             if s0[i]=')' then dec(j);
             if j<0 then raise EparserError.Create('missing ''(''');
      until j=0;
end;function getvalue(s0:string):extended;
begin
if length(s0)<1 then raise EparserError.Create('syntax error');
if length(s0)=1 then result:=strtofloat(s0) else
  case s0[1] of
       'x':result:=parameter.x;
       'y':result:=parameter.y;
       'z':result:=parameter.z;
       else result:=strtofloat(s0);
       end;
end;function specialF(p1:integer;s0:string):extended;
var operstr:string;arg:extended;
begin
   operstr:=copy(s0,1,p1-1);
   if s0[length(s0)]<>')' then EparserError.CreateFmt('incorrect syntax %s',[s0]);
   arg:=evaluate(copy(s0,p1+1,length(s0)-p1-1));
             if operstr ='sin'     then result:=sin(arg)
        else if operstr ='cos'     then result:=cos(arg)
        else if operstr ='tan'     then result:=sin(arg)/cos(arg)
        else if operstr ='arctan' then result:=arctan(arg)
        else if operstr ='log'    then result:=ln(arg)/ln(10)
        else if operstr ='ln'     then result:=ln(arg)
        else if operstr ='exp'    then result:=exp(arg)
        else if operstr ='sqrt'   then result:=sqrt(arg)
        {enter additional functions here}
        else raise EparserError.CreateFmt('unknown function %s',[s0]);
end;function calculate(p1:integer;s0:string):extended;
   var v1,v2:extended;
begin
   v1:=evaluate(copy(s0,1,p1-1));
   v2:=evaluate(copy(s0,p1+1,length(s0)-p1));
   case s0[p1] of
        '+': result:=v1+v2;
        '-': result:=v1-v2;
        '/': result:=v1/v2;
        '*': result:=v1*v2;
        '^': result:=exp(v2*ln(v1));
        else raise EparserError.CreateFmt('invalid operation %s',[s0]);
        end;
end;function getfirstopp(tot:integer;s0:string):integer;
  var i:integer;
  begin
     if tot=0 then tot:=length(s0);
     for i:=1 to 5 do
         begin
         result:=pos(sopps[i],s0);
         if ((i<3) and (result>0)) then
                   if ((result=1) or (pos(s0[result-1],sopps)>0)) then result:=0;
         if result>0 then if result<tot then exit;
         end;
     if result>tot then result:=0;
  end;function evaluate(s0:string):extended;
   var p1,p2,q1:integer;              
   begin
   p1:=pos('(',s0);p2:=p1;
   if p2>0 then matchbracket(p2,s0);
   if p1=1 then begin
                if p2=length(s0) then begin
                                      delete(s0,p2,1);delete(s0,1,1);
                                      result:=evaluate(s0);
                                      end
                                 else result:=calculate(p2+1,s0);
                exit;
                end;   q1:=getfirstopp(p1,s0);
   if (p1+q1=0) then begin              
                     result:=getvalue(s0);
                     exit;
                     end;
   if q1<>0 then result:=calculate(q1,s0)
            else if length(s0)>p2 then result:=calculate(p2+1,s0)
                                  else result:=specialF(p1,s0);
end;
procedure cleanup(var s0:string);
var i:integer;
begin
     s0:=lowercase(s0);
     i:=pos(' ',s0);while i>0 do begin delete(s0,i,1);i:=pos(' ',s0);end;
end;
function TZMathEdit.getevaluatedString:string;
var s0:string;
begin    s0:=text;
  TRY
     cleanup(s0);
     result:=floattostr(evaluate(s0));
  EXCEPT
     on e:exception do result:=e.message;
  END;
end;function evaluateToFloat(s0:string):extended;
begin
  TRY
     evaluationerror:='';
     cleanup(s0);
     result:=evaluate(s0);
  EXCEPT
     on e:exception do begin
                       evaluationerror:=e.message;
                       result:=0;
                       end;
  END;
end;Function GetEvaluationError:string;
begin
result:=evaluationerror;
end;end.

Answer 4

to  S.F.(饭桶):
    非常好。非常感谢！准备接分！！！
    不过，程序我还没仔细琢磨，我大致看了一下。好像里面是把字符串中可能出现的，如‘X,Y,Z,’等做了规定死了。我在想，能否在你这个基础上，将之做的更灵活一些，可以都以自己输入的参数来进行，然后封装成动态库，使用时直接调用。
 

Answer 5

不好意思，迟来了
a，b：array of string，a变量，b变量值
setlength(a,3);
setlength(b,3);
a[0]:='x';
b[0]:='100'
...
for i:=low(a) to high(a) do
begin
 gs:=stringReplace(gs,a[i],b[i],[rfreplaceall]);
end;

Answer 6

windindance(风舞轻扬) 的方法比较好，代码也简单易懂，控件也是delphi库里带的，建议使用

Answer 7

可以用F1Book1哦，向单元格里输入公式FormularRC[col,row],然后calc,最后从NumericRC[,]里读就可以了：）

Answer 8

windindance(风舞轻扬) 的方法很很好，自己不用动脑子。：）
S.F.(饭桶)的方法也很好。
不过，我想请教一下windindance(风舞轻扬) ，那么多Delphi自带的ActiveX，有这方面介绍的资料吗？

Answer 9

这不是DELPHI带的ACTIVEX，是系统带的，或者是安装了什么特殊的软件后有的。
例如，你安装了Adobe Acrobat Reader,就会有一个Acrobat Control for activex。
所以……帮助是没有。这些资料，想知道的话，上网查吧。

Answer 10

这个Microsoft Script Control 好；我最近学习研究虚拟机，它我最后才考虑使用它；一来，它是标准vbscript/jscript 语法，又支持createObject ，就是windows系统的脚本解释器的ocx版；不过要到自己的程序中让它去访问自己的窗体上的控件并操作它，又太麻烦了，具体的做法mS的msdn 上有介绍，另外还可以找到这种封装了这个ocx的vcl组件，和demo 还有help ...谁要我发给谁（不过得有时间上网）