怎样添加逻辑计算功能,如:if(a>b,x,y) 或if(a=b,x,y)
fahe3 2007-09-07 05:43:57 怎样添加逻辑计算功能,如:if(a>b,x,y)
////////下面是网上下载的控件程序
unit CalcExpress;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, math;
type
TTree=record
num:integer;
con:string;
l,r:pointer;
end;
PTree=^TTree;
TCalcExpress=class(TComponent)
private
Err:boolean;
Bc:integer;
PrevLex,Curlex:integer;
Pos:integer;
FFormula:string;
Tree:pointer;
FVariables:TStrings;
FDefaultNames:boolean;
procedure init(s:string);
function gettree(s:string):pointer;
function deltree(t:PTree):pointer;
procedure Error(s:string);
procedure SetVariables(Value:TStrings);
public
constructor Create(o:TComponent); override;
destructor Destroy;override;
function calc(args: array of Extended):Extended;
published
property Formula:string read FFormula write init;
property Variables:TStrings read FVariables write SetVariables;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TCalcExpress]);
end;
//*********************************************************************
function TCalcExpress.calc(args:array of Extended):Extended;
function c(t:PTREE):Extended;
var r:Extended;
begin
c:=0;
case t^.num of
3: c:=c(t^.l)+c(t^.r); //'+'
4: c:=c(t^.l)-c(t^.r); //'-'
5: c:=c(t^.l)*c(t^.r); //'*'
6: c:=c(t^.l)/c(t^.r); //'/'
7: c:=strtofloat(t^.con);
8: c:=args[strtoint(t^.con)];
9: c:=-c(t^.l);
10: c:=cos( c(t^.l) );
11: c:=sin( c(t^.l) );
12: c:=tan( c(t^.l) );
13: c:=1/tan( c(t^.l) );
14: c:=abs( c(t^.l) );
15: begin
r:=c(t^.l);
if r<0 then c:=-1 else if r>0 then c:=1 else c:=0;
end;
16: c:=sqrt( c(t^.l) );
17: c:=ln( c(t^.l) );
18: c:=exp( c(t^.l) );
19: c:=arcsin( c(t^.l) );
20: c:=arccos( c(t^.l) );
21: c:=arctan( c(t^.l) );
22: c:=pi/2-arctan( c(t^.l) );
23: begin
r:=c(t^.l);
c:=(exp(r)-exp(-r))/2;
end;
24: begin
r:=c(t^.l);
c:=(exp(r)+exp(-r))/2;
end;
25: begin
r:=c(t^.l);
c:=(exp(r)-exp(-r))/(exp(r)+exp(-r));
end;
26: begin
r:=c(t^.l);
c:=(exp(r)+exp(-r))/(exp(r)-exp(-r));
end;
27: begin
r:=c(t^.l);
if r>=0 then c:=1 else c:=0;
end;
28: begin //增加'if(a>b,0,1)'
c:=1; //err
end;
31: c:=exp( c(t^.r)*ln( c(t^.l) ) );
end;
end;
begin
calc:=c(tree);
end;
procedure TCalcExpress.Error(s:string);
begin
Err:=true;
Raise Exception.Create(s);
end;
//*********************************************************************
constructor TCalcExpress.Create(o:TComponent);
begin
inherited;
Tree:=nil;
Formula:='0';
FDefaultNames:=false;
FVariables:=TStringList.Create;
end;
//*********************************************************************
destructor TCalcExpress.Destroy;
begin
DelTree(Tree);
FVariables.Free;
inherited;
end;
//***************************************************************
function TCalcExpress.GetTree(s:string):pointer;
//Get number from string
function getnumber(s:string):string;
begin
Result:='';
try
//Begin
while (pos<=length(s)) and (s[pos] in ['0'..'9']) do
begin
Result:=Result+s[pos];
inc(pos);
end;
if pos>length(s) then exit;
if s[pos]='.' then
begin
//Fraction part
Result:=result+'.';inc(pos);
if (pos>length(s)) or not(s[pos] in ['0'..'9'])
then Error('Wrong number.');
while (pos<=length(s)) and
(s[pos] in ['0'..'9']) do
begin
Result:=Result+s[pos];
inc(pos);
end;
end;
if pos>length(s) then exit;
//Power
if (s[pos]<>'e')and(s[pos]<>'E') then exit;
Result:=Result+s[pos];inc(pos);
if pos>length(s) then Error('Wrong number.');
if s[pos] in ['-','+'] then
begin
Result:=Result+s[pos];
inc(pos);
end;
if (pos>length(s)) or not(s[pos] in ['0'..'9'])
then Error('Wrong number.');
while (pos<=length(s)) and
(s[pos] in ['0'..'9']) do
begin
Result:=Result+s[pos];
inc(pos);
end;
except
end;
end;