一个计算器的代码，欢迎大家点评

　2006-02-04 13:35:25　来源：WEB开发网　　　

核心提示： 例如： 1. CalcExPR('2*5+1')='11' 2. 带条件 CalcExpr('2>1&4<=5 : 2*5')='10' CalcExpr('6<2 : 3')='0' 3. 带函数 C

例如：
　 1. CalcExPR('2*5+1')='11'
　 2. 带条件
　　　 CalcExpr('2>1&4<=5 : 2*5')='10'
　　　 CalcExpr('6<2 : 3')='0'
　 3. 带函数
　　　 CalcExpr('max(1,2,3,6,4+7,7)')='11'

用法：将untCalc.pas 加入到你的工程里面，然后调用CalcExpr即可。

这里是源代码：

unit untJCalc;

interface

uses
　 classes,sysutils;

type
　 TJStack=class
　　 private
　　　　 Lines:TStrings;
　　 public
　　　　 constructor Create;
　　　　 destructor Destroy;
　　　　 procedure init;
　　　　 procedure push(s:string);
　　　　 function GetTop:String;
　　　　 function Pop:String;
　　 end;
　 TJExpr=class
　　 private
　　　　 Expr:String;
　　　　 Position:Integer;
　　　　 Min,max:Integer;
　　　　 Eof:Boolean;
　　 public
　　　　 constructor Create(pExpr:String);
　　　　 function read:String;
　　　　 procedure GoFirst;
　　 end;

function CalcExpr(sExpr:String):String;
function CalcExprItem(sOptr,sA,sB:String):String;
function OptrIndex(w:string):Integer;
function GetParamCount(pFunc:String):Integer;
function ExecFunc(pFunc:String;pParam:Array of string;pParamCount:Integer):string;

implementation

constructor TJStack.Create;
begin
　 inherited Create;
　 lines:=TStringList.create;
end;

procedure TJStack.init;
begin
　 lines.free;
end;

destructor TJStack.Destroy;
begin
　 lines.free;
　 inherited Destroy;
end;

procedure TJStack.push(s:string);
begin
　 lines.add(s);
end;

function TJStack.GetTop:String;
begin
　 if Lines.count>0 then
　　 Result:=lines[lines.count-1]
　　 else
　　 Result:='';
end;

function TJStack.Pop:String;
begin
　 if Lines.Count>0 then
　 begin
　　 Result:=GetTop;
　　 lines.delete(lines.count-1);
　 end
　 else
　　 Result:='';
end;

//////////////////////TJExpr////////////////

constructor TJExpr.Create(pExpr:String);
begin
　 Expr:=lowercase(pExpr)+'#';
　 Min:=1;
　 Max:=length(Expr);
　 Position:=1;
　 Eof:=false;
end;

function TJExpr.read:String;
　 function SameType(s1,s2:string):boolean;
　 var
　　 c1,c2:string;
　 begin
　　 c1:='';c2:='';
　　 if length(s1)>0 then c1:=s1[length(s1)];
　　 if length(s2)>0 then c2:=s2[Length(s2)];
　　 if ((pos(c1,'0123456789.')>0) and (pos(c2,'0123456789.')>0))
　　　　 then
　　　　 begin
　　　　　 result:=true;
　　　　 end
　　　　 else
　　　　 begin
　　　　　 Result:=false;
　　　　 end;
　　 if (c1='-')and(c2='-') then Result:=false;
　　 if s1+s2='>=' then Result:=true;
　　 if s1+s2='<=' then Result:=true;
　　 if s1+s2='<>' then Result:=true;
　　 if pos(s1+s2,'max(')>0 then Result:=true;
　　 if pos('-',s1+s2)>1 then Result:=false;
　　 if (s1='')or(s2='') then result:=true;
　 end;
begin
　 if Position<=Max then
　 begin
　　 Result:=trim(Expr[Position]);
　　 Inc(Position);
　　 while Position<=Max do
　　 begin
　　　　 if SameType(Result,Expr[Position]) then
　　　　 begin
　　　　　 Result:=Result+trim(Expr[Position]);
　　　　　 Inc(Position);
　　　　 end
　　　　 else
　　　　 begin
　　　　　 exit;
　　　　 end;
　　 end;
　 end
　 else
　 begin
　　 Result:='';
　　 Eof:=true;
　 end;
end;

procedure TJExpr.GoFirst;
begin
　 Position:=1;
　 Eof:=false;
end;

/////////////////////////////////////////

function CalcExpr(sExpr:String):String;
var
　 optr,opnd:TJStack;
　 w,theta,a,b:string;
　 position:integer;
　 jexpr:TJExpr;
　 sParam:array[1..20] of string;
　 sFunc:String;
　 i,nParamCount:integer;
begin
　 jexpr:=TjExpr.Create(sExpr);
　 optr:=TJStack.create;
　 opnd:=TJStack.create;
　 optr.push('#');
　 w:=jexpr.read;
　 while (not ((w='#')and(optr.GetTop='#'))) and (jexpr.Eof =false) do
　 begin
　　 if OptrIndex(w)<0 then
　　 begin
　　　　 opnd.push(w);
　　　　 w:=jexpr.read;
　　 end
　　 else
　　 begin
　　　　 Case DiffOptr(optr.GetTop,w) of
　　　　　 -1://<
　　　　　　 begin
　　　　　　　　 optr.push(w);
　　　　　　　　 w:=jexpr.read;
　　　　　　 end;
　　　　　 0://=
　　　　　　 begin
　　　　　　　　 sFunc:=optr.pop;
　　　　　　　　 if sFunc<>'(' then
　　　　　　　　 begin
　　　　　　　　　 nParamCount:=1;
　　　　　　　　　 while sFunc=',' do
　　　　　　　　　 begin
　　　　　　　　　　　 Inc(nParamCount);
　　　　　　　　　　　 sFunc:=optr.pop;
　　　　　　　　　 end;
　　　　　　　　　 if GetParamCount(sFunc)=0 then nParamCount:=0;
　　　　　　　　　 for i:=1 to nParamCount do sParam[i]:=opnd.Pop;
　　　　　　　　　 opnd.push(ExecFunc(sFunc,sParam,nParamCount));
　　　　　　　　 end;
　　　　　　　　 w:=jexpr.read;
　　　　　　 end;
　　　　　 1://>
　　　　　　 begin
　　　　　　　　 theta:=optr.pop;
　　　　　　　　 b:=opnd.pop;
　　　　　　　　 a:=opnd.pop;
　　　　　　　　 opnd.push(CalcExprItem(theta,a,b));
　　　　　　 end;
　　　　 end;
　　 end;
　 end;
　 Result:=opnd.GetTop;
　 opnd.free;
　 optr.free;
end;

function CalcExprItem(sOptr,sA,sB:String):String;
begin
　 if sOptr='+' then
　 begin
　　 if (sA<>'')and(sB<>'') then
　　 begin
　　　　 Result:=floattostr(strtofloat(sA)+strtofloat(sB));
　　 end
　　 else
　　 begin
　　　　 Result:=sA+sB;
　　　　 if Result='' then Result:='0';
　　 end;
　　 exit;
　 end;
　 if sOptr='-' then
　 begin
　　 if sA='' then
　　　　 Result:=floattostr(-strtofloat(sB))
　　　　 else
　　　　 Result:=floattostr(strtofloat(sA)-strtofloat(sB));
　　 exit;
　 end;
　 if sOptr='*' then
　 begin
　　 Result:=floattostr(strtofloat(sA)*strtofloat(sB));
　　 exit;
　 end;
　 if sOptr='/' then
　 begin
　　 Result:=floattostr(strtofloat(sA)/strtofloat(sB));
　　 exit;
　 end;
　 if sOptr='>' then
　 begin
　　 if strtofloat(sA)>strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='<' then
　 begin
　　 if strtofloat(sA)<strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='>=' then
　 begin
　　 if strtofloat(sA)>=strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='<=' then
　 begin
　　 if strtofloat(sA)<=strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='=' then
　 begin
　　 if strtofloat(sA)=strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='<>' then
　 begin
　　 if strtofloat(sA)<>strtofloat(sB) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr='&' then
　 begin
　　 if (strtofloat(sA)<>0)and(strtofloat(sB)<>0) then
　　　　 Result:='1'
　　　　 else
　　　　 Result:='0';
　　 exit;
　 end;
　 if sOptr=':' then
　 begin
　　 if strtofloat(sA)=0 then
　　　　 Result:='0'
　　　　 else
　　　　 Result:=sB;
　　 exit;
　 end;
end;

function GetParamCount(pFunc:String):Integer;
begin
　 if pFunc='max(' then result:=2;
end;

function OptrIndex(w:string):Integer;
begin
　 if w='+' then begin result:=1; exit; end;
　 if w='-' then begin result:=2; exit; end;
　 if w='*' then begin result:=3; exit; end;
　 if w='/' then begin result:=4; exit; end;
　 if w='(' then begin result:=5; exit; end;
　 if w=')' then begin result:=6; exit; end;
　 if w='#' then begin result:=7; exit; end;
　 if w='>' then begin result:=8; exit; end;
　 if w='<' then begin result:=9; exit; end;
　 if w='>=' then begin result:=10; exit; end;
　 if w='<=' then begin result:=11; exit; end;
　 if w='=' then begin result:=12; exit; end;
　 if w='<>' then begin result:=13; exit; end;
　 if w='&' then begin result:=14; exit; end;
　 if w=':' then begin result:=15; exit; end;
　 if w=',' then begin result:=16; exit; end;
　 if w='max(' then begin Result:=17; exit; end;
　 result:=-1;
end;

function ExecFunc(pFunc:String;pParam:Array of string;pParamCount:Integer):string;
var
　 tmpFloat:real;
　 i:integer;
begin
　 //
　 if pFunc='max(' then
　 begin
　　 tmpFloat:=strtofloat(pParam[0]);
　　 for i:=1 to pParamCount-1 do
　　 begin
　　　　 if tmpFloat<strtofloat(pParam[i]) then
　　　　　 tmpFloat:=strtofloat(pParam[i]);
　　 end;
　　 Result:=floattostr(tmpFloat);
　 end;
end;

end.