Expiring Todayâ€”Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
Solved

# A function to calculate

Posted on 2002-07-11
Medium Priority
267 Views
I would like to seek help for a function to calculate.  Assume you have a edit box and a button.

Example Data : 15/5+6*9/3-8+(5-2)/3
When button is clicked, an answer of the calculation should be out.

The problem is I can't figure function(s) to write and to determine an answer from such complicated long length of mathematics.

0
Question by:ivylnm
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points

Expert Comment

ID: 7148206
hi ivylnm
to calculate such a complecated math you need a (forumla parser), here is a powerfull one.
i found it some where on the web last year.
try it.
good luck

==========================================================
unit evalcomp;
{
Allowed operations:

x <> y ; Logical operations return 1 if true and 0 if false.
x <= y
x >= y
x > y
x < y
x = y
x + y
x - y
x eor y ( exclusive or )
x or y
x * y
x / y
x and y
x mod y
x div y
x ^ y ( power )
x shl y
x shr y
not (x)
sinc (x)
sinh (x)
cosh (x)
tanh (x)
coth (x)
sin (x)
cos (x)
tan (x)
cot (x)
sqrt (x)
sqr (x)
arcsinh (x)
arccosh (x)
arctanh (x)
arccoth (x)
arcsin (x)
arccos (x)
arctan (x)
arccot (x)
heavy (x) ; 1 for positive numbers, 0 else
sgn (x) ; 1 for positive, -1 for negative, 0 for 0
frac (x)
exp (x)
abs (x)
trunc (x)
ln (x)
odd (x)
pred (x)
succ (x)
round (x)
int (x)
fac (x) ; x*(x-1)*(x-2)*...*3*2*1
rnd ; Random number in [0,1]
rnd (x) ; Random number in [0,x]
pi
e
}

interface

type fun= function(x,y:real):real;
evalvec= ^evalobj;
evalobj= object
f1,f2:evalvec;
f1x,f2y:real;
f3:fun;
function eval:real;
function eval1d(x:real):real;
function eval2d(x,y:real):real;
function eval3d(x,y,z:real):real;
constructor init(st:string);
destructor done;
end;
var  evalx,evaly,evalz:real;

implementation

var analysetmp:fun;

function search (text,code:string; var pos:integer):boolean;
var i,count:integer;
flag:boolean;
newtext:string;
begin
if length(text)<length(code) then begin search:=false; exit; end;
flag:=false;
pos:=length(text)-length(code)+1;
repeat
if code=copy(text,pos,length(code))
then flag:=true
else dec(pos);
if flag
then
begin
count:=0;
for i:= pos+1 to length(text) do
begin
if copy(text,i,1) = '(' then inc(count);
if copy(text,i,1) = ')' then dec(count);
end;
if count<>0
then
begin
dec(pos);
flag:=false;
end;
end;
until (flag=true) or (pos=0);
search:=flag;
end;

function myid(x,y:real):real;
begin
myid:=x;
end;

function myunequal(x,y:real):real;
begin
if x<>y then
myunequal:=1
else
myunequal:=0;
end;

function mylessequal(x,y:real):real;
begin
if x<=y then
mylessequal:=1
else
mylessequal:=0;
end;

function mygreaterequal(x,y:real):real;
begin
if x>=y then
mygreaterequal:=1
else
mygreaterequal:=0;
end;

function mygreater(x,y:real):real;
begin
if x>y then
mygreater:=1
else
mygreater:=0;
end;

function myless(x,y:real):real;
begin
if x<y then
myless:=1
else
myless:=0;
end;

function myequal(x,y:real):real;
begin
if x=y then
myequal:=1
else
myequal:=0;
end;

begin
end;

function mysub(x,y:real):real;
begin
mysub:=x-y;
end;

function myeor(x,y:real):real;
begin
myeor:=trunc(x) xor trunc(y);
end;

function myor(x,y:real):real;
begin
myor:=trunc(x) or trunc(y);
end;

function mymult(x,y:real):real;
begin
mymult:=x*y;
end;

function mydivid(x,y:real):real;
begin
mydivid:=x/y;
end;

function myand(x,y:real):real;
begin
myand:=trunc(x) and trunc(y);
end;

function mymod(x,y:real):real;
begin
mymod:=trunc(x) mod trunc(y);
end;

function mydiv(x,y:real):real;
begin
mydiv:=trunc(x) div trunc(y);
end;

function mypower(x,y:real):real;
begin
if x=0 then
mypower:=0
else
if x>0 then
mypower:=exp(y*ln(x))
else
if trunc(y)<>y  then
begin
writeln (' Fehler in x^y ');
halt;
end
else
if odd(trunc(y))=true then
mypower:=-exp(y*ln(-x))
else
mypower:=exp(y*ln(-x))
end;

function myshl(x,y:real):real;
begin
myshl:=trunc(x) shl trunc(y);
end;

function myshr(x,y:real):real;
begin
myshr:=trunc(x) shr trunc(y);
end;

function mynot(x,y:real):real;
begin
mynot:=not trunc(x);
end;

function mysinc(x,y:real):real;
begin
if x=0 then
mysinc:=1
else
mysinc:=sin(x)/x
end;

function mysinh(x,y:real):real;
begin
mysinh:=0.5*(exp(x)-exp(-x))
end;

function mycosh(x,y:real):real;
begin
mycosh:=0.5*(exp(x)+exp(-x))
end;

function mytanh(x,y:real):real;
begin
mytanh:=mysinh(x,0)/mycosh(x,0)
end;

function mycoth(x,y:real):real;
begin
mycoth:=mycosh(x,0)/mysinh(x,0)
end;

function mysin(x,y:real):real;
begin
mysin:=sin(x)
end;

function mycos(x,y:real):real;
begin
mycos:=cos(x)
end;

function mytan(x,y:real):real;
begin
mytan:=sin(x)/cos(x)
end;

function mycot(x,y:real):real;
begin
mycot:=cos(x)/sin(x)
end;

function mysqrt(x,y:real):real;
begin
mysqrt:=sqrt(x)
end;

function mysqr(x,y:real):real;
begin
mysqr:=sqr(x)
end;

function myarcsinh(x,y:real):real;
begin
myarcsinh:=ln(x+sqrt(sqr(x)+1))
end;

function mysgn(x,y:real):real;
begin
if x=0 then
mysgn:=0
else
mysgn:=x/abs(x)
end;

function myarccosh(x,y:real):real;
begin
myarccosh:=ln(x+mysgn(x,0)*sqrt(sqr(x)-1))
end;

function myarctanh(x,y:real):real;
begin
myarctanh:=ln((1+x)/(1-x))/2
end;

function myarccoth(x,y:real):real;
begin
myarccoth:=ln((1-x)/(1+x))/2
end;

function myarcsin(x,y:real):real;
begin
if x=1 then
myarcsin:=pi/2
else
myarcsin:=arctan(x/sqrt(1-sqr(x)))
end;

function myarccos(x,y:real):real;
begin
myarccos:=pi/2-myarcsin(x,0)
end;

function myarctan(x,y:real):real;
begin
myarctan:=arctan(x);
end;

function myarccot(x,y:real):real;
begin
myarccot:=pi/2-arctan(x)
end;

function myheavy(x,y:real):real;
begin
myheavy:=mygreater(x,0)
end;

function myfrac(x,y:real):real;
begin
myfrac:=frac(x)
end;

function myexp(x,y:real):real;
begin
myexp:=exp(x)
end;

function myabs(x,y:real):real;
begin
myabs:=abs(x)
end;

function mytrunc(x,y:real):real;
begin
mytrunc:=trunc(x)
end;

function myln(x,y:real):real;
begin
myln:=ln(x)
end;

function myodd(x,y:real):real;
begin
if odd(trunc(x)) then
myodd:=1
else
myodd:=0;
end;

function mypred(x,y:real):real;
begin
mypred:=pred(trunc(x));
end;

function mysucc(x,y:real):real;
begin
mysucc:=succ(trunc(x));
end;

function myround(x,y:real):real;
begin
myround:=round(x);
end;

function myint(x,y:real):real;
begin
myint:=int(x);
end;

function myfac(x,y:real):real;
var n : integer;
r : real;
begin
if x<0 then begin writeln(' Fehler in Fakultt '); halt; end;
if x = 0 then myfac := 1
else
begin
r := 1;
for n := 1 to trunc ( x ) do
r := r * n;
myfac:= r;
end;
end;

function myrnd(x,y:real):real;
begin
myrnd:=random;
end;

function myrandom(x,y:real):real;
begin
myrandom:=random(trunc(x));
end;

function myevalx(x,y:real):real;
begin
myevalx:=evalx;
end;

function myevaly(x,y:real):real;
begin
myevaly:=evaly;
end;

function myevalz(x,y:real):real;
begin
myevalz:=evalz;
end;

procedure analyse (st:string; var st2,st3:string);
label start;
var pos:integer;
value:real;
newterm,term:string;
begin
term:=st;
start:
if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
newterm:='';
for pos:= 1 to length(term) do
if copy(term,pos,1)<>' ' then newterm:=newterm+copy(term,pos,1);
term:=newterm;
if term='' then begin analysetmp:=myid; st2:='0'; st3:=''; exit; end;
val(term,value,pos);
if pos=0 then begin
analysetmp:=myid;
st2:=term;
st3:='';
exit;
end;
if search(term,'<>',pos) then begin
analysetmp:=myunequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'<=',pos) then begin
analysetmp:=mylessequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>=',pos) then begin
analysetmp:=mygreaterequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'>',pos) then begin
analysetmp:=mygreater;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'<',pos) then begin
analysetmp:=myless;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'=',pos) then begin
analysetmp:=myequal;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'+',pos) then begin
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'-',pos) then begin
analysetmp:=mysub;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'eor',pos) then begin
analysetmp:=myeor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'or',pos) then begin
analysetmp:=myor;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+2,length(term)-pos-1);
exit;
end;
if search(term,'*',pos) then begin
analysetmp:=mymult;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'/',pos) then begin
analysetmp:=mydivid;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'and',pos) then begin
analysetmp:=myand;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'mod',pos) then begin
analysetmp:=mymod;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'div',pos) then begin
analysetmp:=mydiv;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'^',pos) then begin
analysetmp:=mypower;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+1,length(term)-pos);
exit;
end;
if search(term,'shl',pos) then begin
analysetmp:=myshl;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if search(term,'shr',pos) then begin
analysetmp:=myshr;
st2:=copy(term,1,pos-1);
st3:=copy(term,pos+3,length(term)-pos-2);
exit;
end;
if copy(term,1,1)='(' then begin
term:=copy(term,2,length(term)-2);
goto start;
end;
if copy(term,1,3)='not' then begin
analysetmp:=mynot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sinc' then begin
analysetmp:=mysinc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='sinh' then begin
analysetmp:=mysinh;

st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='cosh' then begin
analysetmp:=mycosh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='tanh' then begin
analysetmp:=mytanh;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='coth' then begin
analysetmp:=mycoth;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sin' then begin
analysetmp:=mysin;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cos' then begin
analysetmp:=mycos;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='tan' then begin
analysetmp:=mytan;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='cot' then begin
analysetmp:=mycot;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='sqrt' then begin
analysetmp:=mysqrt;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='sqr' then begin
analysetmp:=mysqr;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,7)='arcsinh' then begin
analysetmp:=myarcsinh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccosh' then begin
analysetmp:=myarccosh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arctanh' then begin
analysetmp:=myarctanh;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,7)='arccoth' then begin
analysetmp:=myarccoth;
st2:=copy(term,8,length(term)-7);
st3:='';
exit;
end;
if copy(term,1,6)='arcsin' then begin
analysetmp:=myarcsin;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccos' then begin
analysetmp:=myarccos;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arctan' then begin
analysetmp:=myarctan;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,6)='arccot' then begin
analysetmp:=myarccot;
st2:=copy(term,7,length(term)-6);
st3:='';
exit;
end;
if copy(term,1,5)='heavy' then begin
analysetmp:=myheavy;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='sgn' then begin
analysetmp:=mysgn;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='frac' then begin
analysetmp:=myfrac;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,3)='exp' then begin
analysetmp:=myexp;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='abs' then begin
analysetmp:=myabs;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,5)='trunc' then begin
analysetmp:=mytrunc;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,2)='ln' then begin
analysetmp:=myln;
st2:=copy(term,3,length(term)-2);
st3:='';
exit;
end;
if copy(term,1,3)='odd' then begin
analysetmp:=myodd;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,4)='pred' then begin
analysetmp:=mypred;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,4)='succ' then begin
analysetmp:=mysucc;
st2:=copy(term,5,length(term)-4);
st3:='';
exit;
end;
if copy(term,1,5)='round' then begin
analysetmp:=myround;
st2:=copy(term,6,length(term)-5);
st3:='';
exit;
end;
if copy(term,1,3)='int' then begin
analysetmp:=myint;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if copy(term,1,3)='fac' then begin
analysetmp:=myfac;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='rnd' then begin
analysetmp:=myrnd;
st2:='';
st3:='';
exit;
end;
if copy(term,1,3)='rnd' then begin
analysetmp:=myrandom;
st2:=copy(term,4,length(term)-3);
st3:='';
exit;
end;
if term='x' then begin
analysetmp:=myevalx;
st2:='';
st3:='';
exit;
end;
if term='y' then begin
analysetmp:=myevaly;
st2:='';
st3:='';
exit;
end;
if term='z' then begin
analysetmp:=myevalz;
st2:='';
st3:='';
exit;
end;
if (term='pi') then begin
analysetmp:=myid;
str(pi,st2);
st3:='';
exit;
end;
if term='e' then begin
analysetmp:=myid;
str(exp(1),st2);
st3:='';
exit;
end;
writeln(' WARNING : UNDECODABLE FORMULA ');
analysetmp:=myid;
st2:='';
st3:='';
end;

function evalobj.eval:real;
var tmpx,tmpy:real;
begin
if f1=nil then
tmpx:=f1x
else
tmpx:=f1^.eval;
if f2=nil then
tmpy:=f2y
else
tmpy:=f2^.eval;
eval:=f3(tmpx,tmpy);
end;

function evalobj.eval1d(x:real):real;
begin
evalx:=x;
evaly:=0;
evalz:=0;
eval1d:=eval;
end;

function evalobj.eval2d(x,y:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=0;
eval2d:=eval;
end;

function evalobj.eval3d(x,y,z:real):real;
begin
evalx:=x;
evaly:=y;
evalz:=z;
eval3d:=eval;
end;

constructor evalobj.init(st:string);
var st2,st3:string;
error:integer;
begin
f1:=nil;
f2:=nil;
analyse(st,st2,st3);
f3:=analysetmp;
val(st2,f1x,error);
if st2='' then
begin
f1x:=0;
error:=0;
end;
if error<>0 then
new (f1,init(st2));
val(st3,f2y,error);
if st3='' then
begin
f2y:=0;
error:=0;
end;
if error<>0 then
new (f2,init(st3));
end;

destructor evalobj.done;
begin
if f1<>nil then
dispose(f1,done);
if f2<>nil then
dispose(f2,done);
end;

end.
==========================================================
0

LVL 1

Expert Comment

ID: 7149119
Is this a homework?
0

LVL 1

Expert Comment

ID: 7149277
Try this code, if you understand it you can add functionality for other mathematical functions easily.
(now +,-,*,/,^(exponential))

I used a stack (LIFO) for saving the data needed.
The Pop operation should return Data and delete the Item.
Using a different stack it could look like:

"
MyStack.push(FloatToStr(Power(Operand2,Operand1)));
"

The IsEmpty function should be also implemented some way.
The Power function is in the unit math.

_________________________________________________

function nextItem(var Equation : String) : String;
var
index : integer;
begin

index := 1;

while (Equation[index] in ['0'..'9']) do
begin
inc(index);
end;

if index > 1 then begin dec(index); end;
result := copy(Equation,0,index);
delete(Equation, 1,index);
end;

function prio(var Operator : Char) : Integer;
begin

case Operator of
'+','-' : result := 1;
'*','/' : result := 2;
'^'     : result := 3;
else
result := 0;
end;

end;

function InfixPostfix(Equation : String) : String;
var
Token : String;
begin

push(MyStack,'(');
Equation := Equation + ')';
while IsEmpty(MyStack) = False do
begin
Token := nextItem(Equation);
case PChar(Token)^ of

'0'..'9' :
begin
result := result + Token + ' ';
end;
'+','-','*','/','^' :
begin
while prio(PChar(MyStack.Data)^) >= prio(PChar(Token)^) do
begin
result := result + pop(MyStack) + ' ';
end;
push(MyStack,Token);
end;
'(' :
begin
push(MyStack,Token);
end;
')' :
begin
while MyStack.Data <> '(' do
begin
result := result + pop(MyStack) + ' ';
end;
pop(MyStack);
end;
end;
end;
end;

function CalculatePostfix(Equation : String) : Extended;
var
Token : String;
Operand1, Operand2 : Extended;
begin

Equation := Equation + ')';
Token := nextItem(Equation);
while Token <> ')' do
begin

case PChar(Token)^ of
'0'..'9' :
begin
push(MyStack,Token);
end;
'+':
begin
push(MyStack,FloatToStr(StrToFloat(pop(MyStack)) + StrToFloat(pop(MyStack))));
end;
'-':
begin
Operand1 := StrToFloat(pop(MyStack));
Operand2 := StrToFloat(pop(MyStack));
push(MyStack,FloatToStr(Operand2 - Operand1 ));
end;
'*':
begin
push(MyStack,FloatToStr(StrToFloat(pop(MyStack)) * StrToFloat(pop(MyStack))));
end;
'/':
begin
Operand1 := StrToFloat(pop(MyStack));
Operand2 := StrToFloat(pop(MyStack));
push(MyStack,FloatToStr(Operand2 / Operand1));
end;
'^':
begin
Operand1 := StrToFloat(pop(MyStack));
Operand2 := StrToFloat(pop(MyStack));
push(MyStack,FloatToStr(Power(Operand2,Operand1)));
end;

end;
Token := nextItem(Equation);
end;
result := StrToFloat(pop(MyStack));
end;

end.

______________________________________

call it this way:

Label1.Caption := Floattostr(calculatepostfix(infixpostfix(edit1.Text)));

______________________________________

I think this version is more useful for you than the other code found by Ahmed1, because it is not so overloaded.

Greeds
Omycron
0

LVL 6

Expert Comment

ID: 7150943
There is an expression parser, evaluator that will do what you want called "expr" - under the Delphi section.

http://www.blacky.co.nz/free/index.htm
0

LVL 14

Expert Comment

ID: 7151002
Or you could add a scripting control to your form and then let the control evaluate the expression
0

LVL 1

Expert Comment

ID: 7151157
For your term my solution seems to be the best way.
Just try it
0

Author Comment

ID: 7153543
Dear Omycron, I am trying to implement your codes.  But I find errors when compiling.

[Error] OTCalculator.pas(44): Undeclared identifier: 'push'

What libraries I need to include? I have written only these into the unit.

uses Contnrs, math, Windows;

0

LVL 1

Expert Comment

ID: 7154182
Hi ivylnm,
I have used a self written stack based on a self written list. These units have not been taken from the standard libary but I will give you an example how to implement the functions with standard units.
0

LVL 1

Accepted Solution

Omycron earned 400 total points
ID: 7154415
Man I really hpoe this is not a homework ;-), though take this:

unit InfixToPostfix;

interface
uses
SysUtils,Classes,Math,Contnrs;

function nextItem(var Equation : String) : String;
function InfixPostfix(Equation : String) : String;
function CalculatePostfix(Equation : String) : Extended;

var
MyStack : TStringList;

implementation

function nextItem(var Equation : String) : String;
var
index : integer;
begin

index := 1;

while (Equation[index] in ['0'..'9']) do
begin
inc(index);
end;

if index > 1 then begin dec(index); end;
result := copy(Equation,0,index);
delete(Equation, 1,index);
end;

function prio(var Operator : Char) : Integer;
begin

case Operator of
'+','-' : result := 1;
'*','/' : result := 2;
'^'     : result := 3;
else
result := 0;
end;

end;

function InfixPostfix(Equation : String) : String;
var
Token, Temp : String;
begin
Mystack := TStringlist.Create;

Equation := Equation + ')';
while MyStack.Count <> 0 do
begin
Token := nextItem(Equation);
case PChar(Token)^ of

'0'..'9' :
begin
result := result + Token + ' ';
end;
'+','-','*','/','^' :
begin

while prio(PChar(MyStack.Strings[MyStack.Count-1])^) >= prio(PChar(Token)^) do
begin
result := result + MyStack.Strings[MyStack.Count-1] + ' ';
MyStack.Delete(MyStack.Count-1);
end;
end;
'(' :
begin
end;
')' :
begin
while MyStack.Strings[MyStack.Count-1]  <> '(' do
begin
result := result + MyStack.Strings[MyStack.Count-1] + ' ';
MyStack.Delete(MyStack.Count-1);
end;
MyStack.Delete(MyStack.Count-1);
end;
end;
end;
end;

function CalculatePostfix(Equation : String) : Extended;
var
Token,Temp : String;
Operand1, Operand2 : Extended;
begin

Equation := Equation + ')';
Token := nextItem(Equation);
while Token <> ')' do
begin

case PChar(Token)^ of
'0'..'9' :
begin
end;
'+':
begin
Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;
'-':
begin
Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;
'*':
begin
Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;
'/':
begin
Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;
'^':
begin
Operand1 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
Operand2 := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;

end;
Token := nextItem(Equation);
end;
result := StrToFloat(MyStack.Strings[MyStack.Count-1]);
MyStack.Delete(MyStack.Count-1);
end;

end.

--------------------------------

It is still called MyStack but actually it is a Stringlist but this is not important for the program.

Greeds
Omycron
0

Author Comment

ID: 7155913
Omycron,  rest assured that it is not homework ya.  Thanks for help.
0

Author Comment

ID: 7156452
Thanks so much for helping me ~
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usuaâ€¦
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi databaseâ€¦
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as formâ€¦
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infrasâ€¦
###### Suggested Courses
Course of the Month11 days, 5 hours left to enroll