ماشین حساب

[آبجی]

http://delphiarea.com/external/calc/calculator.gif
کد:

procedure Calculator;
var
Value: Double;
begin
Writeln('Enter an expression or X to exit:');
FetchNextChar(True);
while C <> 'X' do
begin
if GetExpression(Value) and (C = '=') then
Writeln(Value)
else
begin
Writeln('Illegal expression!');
while C <> '=' do { ignores the rest of the illegal expression }
FetchNextChar(True);
end;
Writeln;
Writeln('Enter an expression or X to exit:');
FetchNextChar(True);
end;
end;
عبارت:
http://delphiarea.com/external/calc/expression.gif
کد:

function GetExpression(var Expr: Double): Boolean;
var
NextTerm: Double;
Op: Char;
begin
Result := False;
if GetTerm(Expr) then
begin
Result := True;
while Result and (C in ['+', '-']) do
begin
Op := C;
FetchNextChar(True);
Result := False;
if GetTerm(NextTerm) then
begin
case Op of
'+': Expr := Expr + NextTerm;
'-': Expr := Expr - NextTerm;
end;
Result := True;
end;
end;
end;
end;
جمله:
http://delphiarea.com/external/calc/term.gif
کد:

function GetTerm(var Term: Double): Boolean;
var
NextFactor: Double;
Op: Char;
begin
Result := False;
if GetFactor(Term) then
begin
Result := True;
while Result and (C in ['*', '/']) do
begin
Op := C;
FetchNextChar(True);
Result := False;
if GetFactor(NextFactor) then
begin
if Op = '*' then
begin
Term := Term * NextFactor;
Result := True;
end
else if NextFactor <> 0 then
begin
Term := Term / NextFactor;
Result := True;
end;
end;
end;
end;
end;
ضریب:
http://delphiarea.com/external/calc/factor.gif
کد:

function GetFactor(var Factor: Double): Boolean;
var
Negate: Boolean;
begin
Result := False;
Negate := False;
if C in ['+', '-'] then
begin
if C = '-' then
Negate := True;
FetchNextChar(True);
end;
if C = '(' then
begin
FetchNextChar(True);
if GetExpression(Factor) and (C = ')') then
begin
FetchNextChar(True);
Result := True;
end;
end
else if GetNumber(Factor) then
Result := True;
if Negate then
Factor := -Factor;
end;
عدد:
http://delphiarea.com/external/calc/number.gif
کد:

function GetNumber(var Number: Double): Boolean;
var
Digit: Integer;
Fraction: Double;
PointPos, P: Integer;
begin
Result := False;
Number := 0;
while GetDigit(Digit) do
begin
Number := Number * 10 + Digit;
FetchNextChar(False);
Result := True;
end;
if C = '.' then
begin
FetchNextChar(False);
PointPos := 0;
while GetDigit(Digit) do
begin
Fraction := Digit;
Inc(PointPos);
for P := 1 to PointPos do
Fraction := Fraction / 10;
Number := Number + Fraction;
FetchNextChar(False);
Result := True;
end;
end;
if C in BlankChars then
FetchNextChar(True);
end;
رقم:
http://delphiarea.com/external/calc/digit.gif
کد:

function GetDigit(var Digit: Integer): Boolean;
begin
Result := False;
if C in ['0'..'9'] then
begin
Digit := Ord(C) - Ord('0');
Result := True;
end;
end;