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

例如:
1. CalcExpr('25+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 DiffOptr(a,b:string):Integer;
const
sa:array [1..17,1..17] of
integer=(
// + - * / ( ) # > < >= <= = <> & : , max(
{+}(2 ,2 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{-}(2 ,2 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{*}(2 ,2 ,2 ,2 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{/}(2 ,2 ,2 ,2 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{(}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{)}(2 ,2 ,2 ,2 ,1 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,1),
{#}(0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{>}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{>=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<>}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{&}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,0),
{:}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,2 ,2 ,0),
{,}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{max(}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0)
);
var
aIndex,bIndex:integer;
begin
aIndex:=OptrIndex(a);
bIndex:=OptrIndex(b);
if (aIndex>0)and(bIndex>0) then
Result:=sa[aIndex,bIndex]-1
else
Result:=1;
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)

 1<strtofloat(sb) ;="" begin="" else="" end;="" exit;="" if="" result:="0" soptr="&gt;=" strtofloat(sa)="" then="">=strtofloat(sB) then   
 2Result:='1'   
 3else   
 4Result:='0';   
 5exit;   
 6end;   
 7if sOptr='&lt;=' then   
 8begin   
 9if strtofloat(sA)&lt;=strtofloat(sB) then   
10Result:='1'   
11else   
12Result:='0';   
13exit;   
14end;   
15if sOptr='=' then   
16begin   
17if strtofloat(sA)=strtofloat(sB) then   
18Result:='1'   
19else   
20Result:='0';   
21exit;   
22end;   
23if sOptr='&lt;&gt;' then   
24begin   
25if strtofloat(sA)&lt;&gt;strtofloat(sB) then   
26Result:='1'   
27else   
28Result:='0';   
29exit;   
30end;   
31if sOptr='&amp;' then   
32begin   
33if (strtofloat(sA)&lt;&gt;0)and(strtofloat(sB)&lt;&gt;0) then   
34Result:='1'   
35else   
36Result:='0';   
37exit;   
38end;   
39if sOptr=':' then   
40begin   
41if strtofloat(sA)=0 then   
42Result:='0'   
43else   
44Result:=sB;   
45exit;   
46end;   
47end; 
48
49function GetParamCount(pFunc:String):Integer;   
50begin   
51if pFunc='max(' then result:=2;   
52end; 
53
54function OptrIndex(w:string):Integer;   
55begin   
56if w='+' then begin result:=1; exit; end;   
57if w='-' then begin result:=2; exit; end;   
58if w='*' then begin result:=3; exit; end;   
59if w='/' then begin result:=4; exit; end;   
60if w='(' then begin result:=5; exit; end;   
61if w=')' then begin result:=6; exit; end;   
62if w='#' then begin result:=7; exit; end;   
63if w='&gt;' then begin result:=8; exit; end;   
64if w='&lt;' then begin result:=9; exit; end;   
65if w='&gt;=' then begin result:=10; exit; end;   
66if w='&lt;=' then begin result:=11; exit; end;   
67if w='=' then begin result:=12; exit; end;   
68if w='&lt;&gt;' then begin result:=13; exit; end;   
69if w='&amp;' then begin result:=14; exit; end;   
70if w=':' then begin result:=15; exit; end;   
71if w=',' then begin result:=16; exit; end;   
72if w='max(' then begin Result:=17; exit; end;   
73result:=-1;   
74end; 
75
76function ExecFunc(pFunc:String;pParam:Array of string;pParamCount:Integer):string;   
77var   
78tmpFloat:real;   
79i:integer;   
80begin   
81//   
82if pFunc='max(' then   
83begin   
84tmpFloat:=strtofloat(pParam[0]);   
85for i:=1 to pParamCount-1 do   
86begin   
87if tmpFloat&lt;strtofloat(pParam[i]) then   
88tmpFloat:=strtofloat(pParam[i]);   
89end;   
90Result:=floattostr(tmpFloat);   
91end;   
92end; 
93
94end.</strtofloat(sb)>
Published At
Categories with Web编程
comments powered by Disqus