송동일 wrote:

> 안녕들 하신가요?

> 어떤 공식을 입력시켜 두고 데이타를 공식에 적용하려 합니다.

> 공식이 영구적이라면 프로그램 코드에 함수로 만들어 놓겠는데...

> 수정가능성이 있는거라서...

>

> 위와같은 공식을 프로그램 수행중에 변경할 수 있는 방법이 있나요?

> 공식은 a=b+c 나 a=b*c+d등 여러가지가 될수 있어요...

>

> 참고로 db는 오라클을 쓰고 있습니다.

> 질문이 너무 초보적인가요? 그래도 좀...

> 그럼 오늘도 즐거운 코딩되시길...



문자열 수식문장(expression)의 결과 구하기

안녕하세요 김영대입니다

아래 소스는 전에 제 홈페이지의 Delphi Tip & Trick 에 올렸던

예제인데 정확한 해답은 아니지만 조금만 수정하면 원하시는 결과를

얻을 수 있을것 같아서 올립니다



아래 예제는 화면의 Edit1의 Text에 sqrt(43.23*12+3.1/1.64) 등등의 임의의

수식을 입력하고 버튼을 클릭하면 그 결과를 계산해서 보여주고 만약 잘못된

수식이면 에러난 문자로 캐럿을 이동시킵니다



이 소스를 보시고

sqrt(43.23*12+3.1/1.64) -> sqrt(a*b+c/d) 이런 식으로 입력하고

해당 변수(a,b,c,d)에 값을 넣은 식으로 바꾸시면 될 듯 합니다





unit Unit1;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, forms, Dialogs,

StdCtrls;



type

Tform1 = class(Tform)

Edit1: TEdit;

Button1: TButton;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;



var

form1: Tform1;



implementation

{$R *.DFM}



procedure Eval(formula: String; {Expression to be evaluated}

var Value: double; {Return value}

var ErrPos: Integer); {error position}

const

Digit: Set of Char = ['0'..'9'];

var

Posn: Integer; {Current position in formula}

CurrChar: Char; {character at Posn in formula}



procedure ParseNext;

begin

repeat

Posn := Posn+1;

if Posn <= Length(formula) then

CurrChar := formula[Posn]

else

CurrChar := ^M;

until CurrChar<>' ';

end {ParseNext};



function add_subt: Real;

var

E: Real;

Opr: Char;



function mult_DIV: Real;

var

S : Real;

Opr : Char;



function Power: Real;

var

T : Real;



function Signedop: Real;



function Unsignedop: Real;

type

StdFunc = (fabs, fsqrt, fsqr, fsin, fcos,

farctan, fln, flog, fexp, ffact);

StdFuncList = array[StdFunc] of String[6];



const

StdFuncName: StdFuncList =

('ABS','SQRT','SQR','SIN','COS',

'ARCTAN','LN','LOG','EXP','FACT');

var

E, L, Start : Integer;

Funnet : Boolean;

F : Real;

Sf : StdFunc;



function Fact(I: Integer): Real;

begin

if I > 0 then

begin

Fact := I*Fact(I-1);

end

else

Fact := 1;

end {Fact};



begin {function Unsignedop}

if CurrChar in Digit then

begin

Start := Posn;

repeat

ParseNext

until not (CurrChar in Digit);

if CurrChar = '.' then

repeat

ParseNext

until not (CurrChar in Digit);

if CurrChar = 'E' then

begin

ParseNext;

repeat

ParseNext

until not (CurrChar in Digit);

end;

Val(Copy(formula,Start,Posn-Start),F,ErrPos);

end

else if CurrChar = '(' then

begin

ParseNext;

F := add_subt;

if CurrChar=')' then

ParseNext

else

ErrPos := Posn;

end

else

begin

Funnet := False;

for sf := fabs tO ffact do

if not Funnet then

begin

l := Length(StdFuncName[sf]);

if Copy(formula,Posn,l)=StdFuncName[sf] then

begin

Posn := Posn+l-1;

ParseNext;

f := Unsignedop;

case sf of

fabs: f := abs(f);

fsqrt: f := SqrT(f);

fsqr: f := Sqr(f);

fsin: f := Sin(f);

fcos: f := Cos(f);

farctan: f := ArcTan(f);

fln : f := LN(f);

flog: f := LN(f)/LN(10);

fexp: f := EXP(f);

ffact: f := fact(Trunc(f));

end;

Funnet := True;

end;

end;

if not Funnet then

begin

ErrPos := Posn;

f := 0;

end;

end;

Unsignedop := F;

end {Unsignedop};



begin {Signedop}

if CurrChar='-' then

begin

ParseNext;

Signedop := -Unsignedop;

end

else

Signedop := Unsignedop;

end {Signedop};



begin {Power}

T := Signedop;

while CurrChar='^' do

begin

ParseNext;

if t <> 0 then

t := EXP(LN(abs(t))*Signedop)

else

t := 0;

end;

Power := t;

end {Power};



begin {mult_DIV}

s := Power;

while CurrChar in ['*','/'] do

begin

Opr := CurrChar;

ParseNext;

case Opr of

'*': s := s * Power;

'/': s := s / Power;

end;

end;

mult_DIV := s;

end {mult_DIV};



begin {add_subt}

E := mult_DIV;

while CurrChar in ['+','-'] do

begin

Opr := CurrChar;

ParseNext;

case Opr of

'+': e := e + mult_DIV;

'-': e := e - mult_DIV;

end;

end;

add_subt := E;

end {add_subt};



begin {PROC Eval}

if formula[1] = '.' then

formula := '0' + formula;

if formula[1]='+' then

Delete(formula,1,1);

for Posn:=1 to Length(formula) do

formula[Posn] := Upcase(formula[Posn]);

Posn := 0;

ParseNext;

Value := add_subt;

if CurrChar=^M then

ErrPos := 0

else

ErrPos := Posn;

end {PROC Eval};



procedure Tform1.Button1Click(Sender: TObject);

var

Value: double;

ErrPos: Integer;

begin

Eval(Edit1.Text, Value, ErrPos);

Label1.Caption := FloatToStr(Value); // 결과값



if ErrPos > 0 then // 에러가 있다면 해당 문자로 캐럿을 위치 시킨다

begin

Edit1.SetFocus;

{두번째 문자 위치로 커서를 보낸대}

Edit1.SelStart := ErrPos - 1;

{문자를 선택하지 않은 상태로 만든다}

Edit1.SelLength := 0;

end;

end;



end.