// built by Liu Yang 2002.1.8library Expression;uses Dialogs, Math, SysUtils;Const 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;
续procedure factor(var fv:extended); 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.
相当于pascal 的 write
相当于c 的 printf还犹豫什么,Delphi有源码
http://lyhome.3322.net/lysoft/Expression.dll
稍后我会发布源代码!
Expression.dll
怎么用?
ScriptControl1.Language:='JavaScript';
ShowMessage(ScriptControl1.Eval('2*3+5'));
就可以了。
在Win98中可以把Win2K下的msscript.ocx拷过来用。
此控件可以进行复杂的运算,如支持'(',组合运算等。甚至可以对整型数进行位运算。
标题 计算出用字符串表示的数学表达式的值 ly_liuyang(原作)
关键字 字符串 表达式
// built by Liu Yang 2002.1.8library Expression;uses Dialogs, Math, SysUtils;Const
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.
(*//
标题:计算表达式
说明:加、减、乘、除及括号;请大家多多测试
设计:Zswang
日期:2002-01-26
支持:[email protected]
//*)