|
// 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
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.
|
