// built by Liu Yang 2002.1.8
library 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
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
