// 화면의 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. |
|
