计算出用字符串表示的数学表达式的值
2008-04-10 02:57:58来源:互联网 阅读 ()
// 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
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
下一篇:delphi常用文档之二
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash