回复人: li_zhifu(东北人) ( ) 信誉:100 2002-2-16 20:02:45 得分:0
唉,你们都是怎么了,这个问题M$已经有了一个解决方案了。在Win2K下在Delphi中Import ActiveX Control,选Microsoft Script Control 1.0,安装,在应用程序中
ScriptControl1.Language:='JavaScript';
ShowMessage(ScriptControl1.Eval('2*3+5'));
就可以了。
在Win98中可以把Win2K下的msscript.ocx拷过来用。
此控件可以进行复杂的运算,如支持'(',组合运算等。甚至可以对整型数进行位运算。
唉,你们都是怎么了,这个问题M$已经有了一个解决方案了。在Win2K下在Delphi中Import ActiveX Control,选Microsoft Script Control 1.0,安装,在应用程序中
ScriptControl1.Language:='JavaScript';
ShowMessage(ScriptControl1.Eval('2*3+5'));
就可以了。
在Win98中可以把Win2K下的msscript.ocx拷过来用。
此控件可以进行复杂的运算,如支持'(',组合运算等。甚至可以对整型数进行位运算。
(*//
标题:计算表达式
说明:加、减、乘、除及括号;请大家多多测试
设计:Zswang
日期:2002-01-26
支持:[email protected]
//*)
Symbol_Mod='M'; Symbol_Div='D';
Symbol_Shl='L'; Symbol_Shr='R';
Symbol_Or='O'; Symbol_Xor='X';
Symbol_And='A';function ConvertExpression(ExpressionString:PChar):PChar; stdcall;
var inputexp:string;
begin
inputexp:=ExpressionString;
//convert input expression to recognize expression
if pos('=',inputexp)=0 then inputexp:=inputexp+'=' else inputexp:=Copy(inputexp,1,Pos('=',inputexp));
inputexp:=UpperCase(inputexp);
inputexp:=StringReplace(inputexp,' ','',[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'MOD',Symbol_Mod,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'DIV',Symbol_Div,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'AND',Symbol_And,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'XOR',Symbol_Xor,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'OR',Symbol_Or,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'SHL',Symbol_Shl,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'SHR',Symbol_Shr,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'(-','(0-',[rfReplaceAll]);
if pos('-',inputexp)=1 then inputexp:='0'+inputexp;
Result:=PChar(inputexp);
end;function ParseExpression(ExpressionString:PChar): extended; stdcall;
var
nextch:char;
nextchpos,position:word;
inputexp:string;
procedure expression(var ev:extended);forward;
procedure readnextch;
begin
repeat
if inputexp[position]='=' then nextch:='='
else
begin
inc(nextchpos);
inc(position);
nextch:=inputexp[position];
end;
until (nextch<>' ') or eoln;
end;
procedure error(ErrorString:string);
begin
MessageDlg('Unknown expression : '+ErrorString,mterror,[mbok],0);
exit;
end;
procedure number(var nv:extended);
var radix:longint; snv:string;
function BinToInt(value: string): integer;
var i,size:integer;
begin // convert binary number to integer
result:=0;
size:=length(value);
for i:=size downto 1 do
if copy(value,i,1)='1'
then result:=result+(1 shl (size-i));
end;
begin
nv:=0;
snv:='';
while nextch in ['0'..'9','A'..'F'] do
begin
// nv:=10*nv+ord(nextch)-ord('0');
snv:=snv+nextch;
readnextch;
end;
// parse Hex, Bin
if snv<>'' then
if snv[Length(snv)]='B'
then nv:=BinToInt(Copy(snv,1,Length(snv)-1))
else if nextch='H' then begin nv:=StrToInt('$'+snv); readnextch; end
else nv:=StrToInt(snv);
if nextch='.' then
begin
radix:=10;
readnextch;
while nextch in ['0'..'9'] do
begin
nv:=nv+(ord(nextch)-ord('0'))/radix;
radix:=radix*10;
readnextch;
end;
end;
end;
Var Symbol:string;
function CalcN(Value:integer):extended;
var i:integer;
begin
Result:=1;
if Value=0 then Exit
else for i:=1 to Value do
Result:=Result*i;
end;
function ParseFunction(var FunctionSymbol:string):boolean;
begin
FunctionSymbol:='';
while not (nextch in ['0'..'9','.','(',')','+','-','*','/','=']) do
begin
FunctionSymbol:=FunctionSymbol+nextch;
readnextch;
end;
if FunctionSymbol='ABS' then Result:=true else
if FunctionSymbol='SIN' then Result:=true else
if FunctionSymbol='COS' then Result:=true else
if FunctionSymbol='TG' then Result:=true else
if FunctionSymbol='TAN' then Result:=true else
if FunctionSymbol='ARCSIN' then Result:=true else
if FunctionSymbol='ARCCOS' then Result:=true else
if FunctionSymbol='ARCTG' then Result:=true else
if FunctionSymbol='ARCTAN' then Result:=true else
if FunctionSymbol='LN' then Result:=true else
if FunctionSymbol='LG' then Result:=true else
if FunctionSymbol='EXP' then Result:=true else
if FunctionSymbol='SQR' then Result:=true else
if FunctionSymbol='SQRT' then Result:=true else
if FunctionSymbol='PI' then Result:=true else
if FunctionSymbol='NOT' then Result:=true else
if FunctionSymbol='N!' then Result:=true else
if FunctionSymbol='E' then Result:=true else
Result:=false;
end;
begin
Case nextch of
'0'..'9' : number(fv);
'(' : begin
readnextch;
expression(fv);
if nextch=')'
then readnextch else error(nextch);
end
else if ParseFunction(Symbol) then
if nextch='(' then
begin
readnextch;
expression(fv);
if Symbol='ABS' then fv:=abs(fv) else
if Symbol='SIN' then fv:=sin(fv) else
if Symbol='COS' then fv:=cos(fv) else
if Symbol='TG' then fv:=tan(fv) else
if Symbol='TAN' then fv:=tan(fv) else
if Symbol='ARCSIN' then fv:=arcsin(fv) else
if Symbol='ARCCOS' then fv:=arccos(fv) else
if Symbol='ARCTG' then fv:=arctan(fv) else
if Symbol='ARCTAN' then fv:=arctan(fv) else
if Symbol='LN' then fv:=ln(fv) else
if Symbol='LG' then fv:=ln(fv)/ln(10) else
if Symbol='EXP' then fv:=exp(fv) else
if Symbol='SQR' then fv:=sqr(fv) else
if Symbol='SQRT' then fv:=sqrt(fv) else
if Symbol='NOT' then fv:=not(Round(fv)) else
if Symbol='N!' then fv:=CalcN(Round(fv)) else
error(symbol);
if nextch=')' then readnextch else error(nextch);
end else begin // parse constant
if Symbol='PI' then fv:=3.14159265358979324 else
if Symbol='E' then fv:=2.71828182845904523 else error(symbol);
end else begin error(Symbol); fv:=1; end;
end;
end;
procedure Power_(var pv:extended);
var
multiop:char;
fs:extended;
begin
factor(pv);
while nextch in ['^'] do
begin
multiop:=nextch;
readnextch;
factor(fs);
case multiop of
'^':if pv<>0.0 then pv:=exp(ln(pv)*fs) else error(multiop);
end;
end;
end;
procedure term_(var tv:extended);
var
multiop:char;
fs:extended;
begin
Power_(tv);
while nextch in ['*','/',Symbol_Mod,Symbol_Div,Symbol_And,Symbol_Shl,Symbol_Shr] do
begin
multiop:=nextch;
readnextch;
Power_(fs);
case multiop of
'*':tv:=tv*fs;
'/':if fs<>0.0 then tv:=tv/fs else error(multiop);
Symbol_Mod:tv:=round(tv) mod round(fs); // prase mod
Symbol_Div:tv:=round(tv) div round(fs); // parse div
Symbol_And:tv:=round(tv) and round(fs); // parse and
Symbol_Shl:tv:=round(tv) shl round(fs); // parse shl
Symbol_Shr:tv:=round(tv) shr round(fs); // parse shr
end;
end;
end;
procedure expression(var ev:extended);
var
addop:char;
fs:extended;
begin
term_(ev);
while nextch in ['+','-',Symbol_Or,Symbol_Xor] do
begin
addop:=nextch;
readnextch;
term_(fs);
case addop of
'+':ev:=ev+fs;
'-':ev:=ev-fs;
Symbol_Or:ev:=round(ev) or round(fs); // parse or
Symbol_Xor:ev:=round(ev) xor round(fs); // parse xor
end;
end;
end;
BEGIN
inputexp:=ConvertExpression(ExpressionString);
if pos('=',inputexp)=0 then
inputexp:=ConvertExpression(ExpressionString);
position:=0;
while inputexp[position]<>'=' do
begin
nextchpos:=0;
readnextch;
expression(result);
end;
END;function ParseExpressionToStr(ExpressionString:PChar):PChar; stdcall;
var ES:string;
begin
ES:=ExpressionString;
if pos('=',ES)=0
then ES:=ES+'='
else ES:=Copy(ES,1,Pos('=',ES));
ES:=ES+FormatFloat('0.000000000000',ParseExpression(ExpressionString));
Result:=PChar(ES);
end;function Version:PChar; stdcall;
begin
Result:='Calculator Dll Build 2001.10.25 Made By Liu Yang All Rights Reserved';
end;Exports
ConvertExpression, ParseExpression, ParseExpressionToStr, Version;
end.
先按照与其他axctivex控件相同的方法导入delphi中,就可以使用他的TScriptControl1对象了。
简单的示例:
ScriptControl1.Language:='vbscript';
t:=ScriptControl1.Eval(‘5/2’);//t的值为2.5
……
当然表达式也可以有sin等函数 是否很简单!!!