分享
 
 
 

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

王朝vc·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

例如:

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有