터보파스칼 시절에 사용하던 것이라..

코딩이 다소 매끄럽지 못합니다..



정확한 원리를 아시려면..

알고리즘에 관한 서적을 보셔야할 것 입니다..



수식을 풀어내는 중위법/선위법 하는 놈들을 알아야 하니까요..

컴파일러에 관한 책에도 나옵니다..



참으로 오랫만에..





From 류..



* P.S. : Compute(P:에러났을 때 위치, Strg:수식, Error:에러났는지 여부):결과값;



Unit BMath;



Interface



Var

IVar : Packed Array [0..50] Of Real;



Function CReal(x:Real):Boolean;

Function Tan(x:Real):Real;

Function ArcCos(x:Real):Real;

Function ArcSin(x:Real):Real;

Function Fact(n:Integer):Real;

Function XY(x,y:Real):Real;

Function nPr(n,r:Integer):Real;

Function nCr(n,r:Integer):Real;

Function nHr(n,r:Integer):Real;

Function nTr(n,r:Integer):Real;

Function Sinh(x:Real):Real;

Function Cosh(x:Real):Real;

Function Tanh(x:Real):Real;

Function Pol(x,y:Real):Real;

Function Log(x:Real):Real;

Function Lg(x,y:Real):Real;

Function Max(x,b:Real):Real;

Function Min(x,b:Real):Real;

Procedure Bound(Var X:Integer; BS,BE:Integer);

Function MaxBound(x,b:Integer):Integer;

Function MinBound(x,b:Integer):Integer;

Function Compute(Var P:Integer; Strg:String; Var Error:Boolean):Real;

Function BoxIn(DataX,DataY,X1,Y1,X2,Y2:Integer):Boolean;



Implementation



Uses

SysUtils;



Function CReal;

var Logic:real;

begin

Logic:=x-round(x);

if Logic=0 then CReal:=False

else CReal:=True

end;



Function Tan;

begin

Tan:=sin(x)/cos(x)

end;



Function ArcCos;

begin

if x<>0 then ArcCos:=ArcTan(sqrt(1/sqr(x)-1))

else ArcCos:=pi/2;

end;



Function ArcSin;

begin

if x<>1 then ArcSin:=ArcTan(sqrt(1/(1-sqr(x))-1))

else ArcSin:=0;

end;



Function Fact;

var F1:Real;

begin

F1:=1;

for n:=1 to n do F1:=F1*n;

Fact:=F1

end;



Function XY;

var FA:real;

begin

if (CReal(y)) and (x<0) then XY:=0

else if x=1 then XY:=1

else if (x>0) and (x<>1) then XY:=Exp(y*Ln(x))

else if x=0 then XY:=0

else if (x=-1) and (odd(round(y))) then XY:=-1

else if (x=-1) and (odd(round(y+1))) then XY:=1

else if (x<0) and (x<>-1) then begin

XY:=1;

if odd(round(y)) then FA:=-1;

XY:=Exp(y*Ln(Abs(x)))*FA

end;

end;



Function nPr;

begin

nPr:=Fact(n)/Fact(n-r)

end;



Function nCr;

begin

nCr:=nPr(n,r)/Fact(r)

end;



Function nHr;

begin

nHr:=nCr(n+r-1,r)

end;



Function nTr;

begin

nTr:=XY(n,r)

end;



Function Sinh;

begin

sinh:=(Exp(x)-Exp(-x))/2

end;



Function Cosh;

begin

Cosh:=(Exp(x)+Exp(-x))/2

end;



Function Tanh;

begin

Tanh:=Sinh(x)/Cosh(x)

end;



Function Pol;

begin

Pol:=Sqrt(sqr(x)+sqr(y))

end;



Function Log;

begin

Log:=Ln(x)/Ln(10)

end;



Function Lg;

begin

Lg:=Ln(y)/ln(x)

end;



Function Max;

begin

if x>b then Max:=b

else Max:=x;

end;



Function Min;

begin

if x
else Min:=x;

end;



Procedure Bound(Var X:Integer; BS,BE:Integer);



Begin

If X > BE then X:= BE;

If X < BS then X:= BS;

End;



Function Maxbound;

begin

if x>b then Maxbound:=b

else Maxbound:=x;

end;



Function Minbound;

begin

if x
else Minbound:=x;

end;



Function Compute(Var P:Integer; Strg:String; Var Error:Boolean):Real;



Var

R : Real;

I, BreakPoint : Integer;

Ch : Char;



Procedure Eval(Var Formula:String; Var Value:Real; Var BreakPoint:Integer);



Const

Numbers : Set Of Char = ['0'..'9','.'];



Var

P, I : Integer;

Ch : Char;



Procedure NextP;



Begin

Repeat

Inc(P);

If P <= Length(Formula) Then Ch:=Formula[P]

Else Ch:=#13;

Until Ch <> ' ';

End;



Function Expr:Real;



Var

E : Real;

Operator : Char;



Function SmplExpr:real;



Var

S : Real;

Operator : Char;



Function Term:Real;



Var

T : Real;



Function S_Fact:Real;



Function Fct:Real;



Var

Fn : String[20];

L, Start : Integer;

F : Real;



Procedure Process_As_Number;



Var

Code : Integer;



Begin

Start:=P;

Repeat NextP; Until Not(Ch In Numbers);

If Ch = '.' Then

Repeat

NextP

Until Not(Ch In Numbers);

If Ch = 'E' then

Begin

NextP;

Repeat

NextP;

UNtil Not(Ch In Numbers);

End;

Val(Copy(Formula, Start, P-Start),F,Code);

End;



Procedure Process_As_New_Expr;



Begin

NextP;

F:=Expr;

If Ch = ')' Then NextP

Else BreakPoint:=P;

End;



Procedure Process_As_Standard_Function;

Var

TempByte : Byte;

Begin

If Formula[P] = '@' then

Begin

NextP;

F:=Fct;

TempByte:= 0;

While (F >= 1) and (F <= 50) Do

Begin

Inc(TempByte);

F:= F-1;

End;

F:= IVar[TempByte];

End

Else If Copy(Formula,P,3) = 'ABS' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Abs(F);

End

Else If Copy(Formula,P,4) = 'SQRT' Then

Begin

Inc(P,3);

NextP;

F:=Fct;

F:=Sqrt(F);

End

Else If Copy(Formula,P,3) = 'SQR' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Sqr(F);

End

Else If Copy(Formula,P,4) = 'SINH' Then

Begin

Inc(P,3);

NextP;

F:=Fct;

F:=Sinh(F);

End

Else If Copy(Formula,P,4) = 'COSH' Then

Begin

Inc(P,3);

NextP;

F:=Fct;

F:=Cosh(F);

End

Else If Copy(Formula,P,4) = 'TANH' Then

Begin

Inc(P,3);

NextP;

F:=Fct;

F:=Tanh(F);

End

Else If Copy(Formula,P,3) = 'SIN' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Sin(F);

End

Else If Copy(Formula,P,3) = 'COS' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Cos(F);

End

Else If Copy(Formula,P,3) = 'TAN' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Tan(F);

End

Else If Copy(Formula,P,6) = 'ARCSIN' Then

Begin

Inc(P,5);

NextP;

F:=Fct;

F:=ArcSin(F);

End

Else If Copy(Formula,P,6) = 'ARCCOS' Then

Begin

Inc(P,5);

NextP;

F:=Fct;

F:=ArcCos(F);

End

Else If Copy(Formula,P,6) = 'ARCTAN' Then

Begin

Inc(P,5);

NextP;

F:=Fct;

F:=ArcTan(F);

End

Else If Copy(Formula,P,2) = 'LN' Then

Begin

Inc(P);

NextP;

F:=Fct;

F:=Ln(F);

End

Else If Copy(Formula,P,3) = 'LOG' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Log(F);

End

Else If Copy(Formula,P,3) = 'EXP' Then

Begin

Inc(P,2);

NextP;

F:=Fct;

F:=Exp(F);

End

Else If Copy(Formula,P,4) = 'FACT' Then

Begin

Inc(P,3);

NextP;

F:=Fct;

F:=Fact(Trunc(F));

End

Else If Copy(Formula,P,2) = '@@' Then

Begin

Inc(P,2);

F:=IVar[Byte(Formula[P])-64];

NextP;

End

Else BreakPoint:=P;

End;



Begin

If (Ch In Numbers) Then Process_As_Number

Else If (Ch = '(') Then Process_As_New_Expr

Else Process_As_Standard_Function;

Fct:=F;

End;



Begin

If Ch = '-' Then

Begin

NextP;

S_Fact:=-Fct;

End

Else S_Fact:=Fct;

End;



Begin

T:=S_Fact;

While Ch = '^' Do

Begin

NextP;

T:=XY(T,S_Fact);

End;

Term:=T;

End;



Begin

S:=Term;

While Ch In ['*','/'] Do

Begin

Operator:=Ch;

NextP;

Case Operator Of

'*' : S:=S*Term;

'/' : S:=S/Term;

End;

End;

SmplExpr:=S;

End;



Begin

E:=SmplExpr;

While Ch In ['+','-'] Do

Begin

Operator:=Ch;

NextP;

Case Operator Of

'+' : E:=E+SmplExpr;

'-' : E:=E-SmplExpr;

End;

End;

Expr:=E;

End;



Begin

Formula:= UpperCase(Formula);

If Formula[1] = '.' Then Formula:='0'+Formula;

If Formula[1] = '+' Then Delete(Formula,1,1);

P:=0;

NextP;

Value:=Expr;

If Ch = #13 Then Error:=False

Else Error:=True;

P:=BreakPoint;

End;



Begin

Eval(Strg,R,P);

Compute:=R;

End;





Function BoxIn(DataX,DataY,X1,Y1,X2,Y2:Integer):Boolean;



Begin

If ((DataX >= X1) and (DataX <= X2)) and

((DataY >= Y1) and (DataY <= Y2)) then BoxIn:= True

Else BoxIn:= False;

End;





End.





광주시델맨 wrote:

>

> 안녕하세요 .!

>

> 광주에서 델파이를 배우며 좀씩 프로그램 해보고 있습니다.

>

> 제겐 아주 중요한 건대요 .

>

> 에디트(Edit)버튼 하나에 다중산술식(예 100+200*2 등)을

>

> 입력된(문자형)경우 어떻게 처리를 해야 하나요..?

>

> 고수님께 한수 부탁드립니다

>

>

>