KMO wrote:

> 빨리 좀 부탁드립니다.

>

> A: String;

> A := '2000 / 12';

> 위의 문자열을 계산할 수 있는 루틴을 부탁드립니다.

> A변수는 어떠한 수식이 올 수도 있습니다.

>

> 그리고

> 만약 변수를 사용하면

>

> A, B, C: String;

>

> A := '2000';

> B := '12';

> C := '*';

>

> A C B

> 2000 * 12 일때도 부탁드립니다.

>

>

> 꼭 좀 부탁합니다. 감사합니다.



아래 예제는 변수처리는 못하고 "43.23*12+3.1/1.64" 처럼 직접 상수들로

이루어진 수식을 계산하는 것인데 변수를 상수로 치환하는 루틴을 추가하면

가능할것 같은데...



// 화면의 Edit1의 Text에 sqrt(43.23*12+3.1/1.64) 를 입력하고

// 버튼을 클릭하시면 그 결과를 계산해서 보여줍니다

// 만약 잘못된 수식이면 에러난 문자로 케럿을 이동시킵니다

//

// 소스 출처: http://www.geocities.com/SiliconValley/Hills/9167/index.htm



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.