核心提示：unit Unit2;interfaceuses Classes, SysUtils;type TTokenType = (ttNone, ttNumber, ttOperator, ttSpace,...
unit Unit2;interface
uses
Classes, SysUtils;
type
TTokenType = (ttNone, ttNumber, ttOperator, ttSpace, ttError, ttEnd);
TOperatorType = (otAdd, otSub, otMul, otDiv);
TDataRec = record
case Kind: TTokenType of
ttNumber : ( Number: Single );
ttOperator : ( Operator: TOperatorType );
end;
PDataRec = ^TDataRec;
TSimpleCalc = class
private
FToken : TDataRec;
FExpression, FEnd, FRun : PAnsiChar;
FDatas : TList;
protected
function DoParse: Boolean;
function DoCalc: Single;
procedure ClearData;
public
constructor Create;
destructor Destroy; override;
function Calculate(const Expression: string; out Ret: Single): Boolean;
end;
function Calculate(const Expression: string; out Ret: Single): Boolean;
implementation
function Calculate(const Expression: string; out Ret: Single): Boolean;
begin
with TSimpleCalc.Create do
try
Result := Calculate(Expression, Ret);
finally
Free;
end;
end;
type
TprocParser = procedure(var Run: PAnsiChar; out Data: TDataRec);
TfuncCalc = function(Val1, Val2: Single): Single;
function Calc_Add(Val1, Val2: Single): Single;
begin
Result := Val1 + Val2;
end;
function Calc_Sub(Val1, Val2: Single): Single;
begin
Result := Val1 - Val2;
end;
function Calc_Mul(Val1, Val2: Single): Single;
begin
Result := Val1 * Val2;
end;
function Calc_Div(Val1, Val2: Single): Single;
begin
Result := Val1 / Val2;
end;
const
ffunCalcs : array[TOperatorType]of function(Val1, Val2: Single): Single =
( Calc_Add, Calc_Sub, Calc_Mul, Calc_Div );
var
procParsers : array[AnsiChar]of TprocParser;
MappedPP : Boolean;
procedure ParserDefault(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttError;
end;
procedure ParserWhiteSpace(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttSpace;
while(Run^in[#9, #10, #13, #32])do Inc(Run);
end;
procedure ParserEOF(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttEnd;
end;
procedure ParserOpt_Add(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttOperator;
Data.Operator := otAdd;
Inc(Run);
end;
procedure ParserOpt_Sub(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttOperator;
Data.Operator := otSub;
Inc(Run);
end;
procedure ParserOpt_Mul(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttOperator;
Data.Operator := otMul;
Inc(Run);
end;
procedure ParserOpt_Div(var Run: PAnsiChar; out Data: TDataRec);
begin
Data.Kind := ttOperator;
Data.Operator := otDiv;
Inc(Run);
end;
const
NumberSet = ['0'..'9'];
procedure ParserDot(var Run: PAnsiChar; out Data: TDataRec);
var
pLast : PAnsiChar;
sToken : string;
begin
pLast := Run;
Inc(Run);
if(not(Run^in NumberSet))then
begin
Data.Kind := ttNone;
Exit;
end;
repeat
Inc(Run);
until not(Run^ in NumberSet);
SetString(sToken, pLast, Run - pLast);
Data.Kind := ttNumber;
Data.Number := StrToFloat(sToken);
end;
procedure ParserN(var Run: PAnsiChar; out Data: TDataRec);
var
pLast : PAnsiChar;
sToken : string;
begin
pLast := Run;
repeat
Inc(Run);
until not(Run^in['0'..'9']);
if(Run^='.')then
repeat
Inc(Run);
until not(Run^ in NumberSet);
SetString(sToken, pLast, Run - pLast);
Data.Kind := ttNumber;
Data.Number := StrToFloat(sToken);
end;
{ TSimpleCalc }
function TSimpleCalc.Calculate(const Expression: string;
out Ret: Single): Boolean;
begin
ClearData;
FExpression := Pointer(Expression);
FEnd := FExpression + Length(Expression);
FRun := FExpression;
FillChar(FToken, SizeOf(FToken), 0);
try
Result := (FEnd>FRun)and DoParse;
if(Result)then
Ret := DoCalc;
except
on E: Exception do
begin
Result := False;
E.Free;
end;
end;
end;
procedure TSimpleCalc.ClearData;
var
i : Integer;
begin
with FDatas do
for i:=Count-1 downto 0 do
Dispose(PDataRec(Items[i]));
FDatas.Clear;
end;
constructor TSimpleCalc.Create;
var
c : AnsiChar;
begin
if(not MappedPP)then
begin
for c:=Low(c)to High(c)do
procParsers[c] := ParserDefault;
for c:='0' to '9' do
procParsers[c] := ParserN;
procParsers['.'] := ParserDot;
procParsers['+'] := ParserOpt_Add;
procParsers['-'] := ParserOpt_Sub;
procParsers['*'] := ParserOpt_Mul;
procParsers['/'] := ParserOpt_Div;
procParsers[#0] := ParserWhiteSpace;
procParsers[#9] := ParserWhiteSpace;
procParsers[#10] := ParserWhiteSpace;
procParsers[#13] := ParserWhiteSpace;
procParsers[#32] := ParserWhiteSpace;
MappedPP := True;
end;
FDatas := TList.Create;
end;
destructor TSimpleCalc.Destroy;
begin
ClearData;
FDatas.Free;
inherited;
end;
function TSimpleCalc.DoCalc: Single;
var
i, it : Integer;
opt : TOperatorType;
begin
// step 1: * and /
i := 0;
while(i<(FDatas.Count shr 1))do
begin
it := i shl 1;
opt := PDataRec(FDatas[it + 1]).Operator;
if(opt in[otAdd, otSub])then
begin
Inc(i);
Continue;
end;
with PDataRec(FDatas[it])^do
Number := ffunCalcs[opt](Number, PDataRec(FDatas[it + 2]).Number);
Dispose(PDataRec(FDatas[it + 1]));
Dispose(PDataRec(FDatas[it + 2]));
FDatas.Delete(it+1);
FDatas.Delete(it+1);
end;
// step 2: + and -
while(FDatas.Count>1)do
begin
with PDataRec(FDatas[0])^do
Number := ffunCalcs[PDataRec(FDatas[1]).Operator]
(Number, PDataRec(FDatas[2]).Number);
Dispose(PDataRec(FDatas[1]));
Dispose(PDataRec(FDatas[2]));
FDatas.Delete(1);
FDatas.Delete(1);
end;
Result := PDataRec(FDatas[0]).Number;
end;
function TSimpleCalc.DoParse: Boolean;
var
pData : PDataRec;
tkLast : TTokenType;
begin
pData := nil;
repeat
tkLast := FToken.Kind;
procParsers[FRun^](FRun, FToken);
with FToken do
case Kind of
ttNone, ttError, ttEnd :
Break;
ttNumber, ttOperator :
begin
if( ((tkLast=ttNone)and(Kind=ttOperator))or
((tkLast<>ttNone)and(tkLast=Kind)) )then
Break;
New(pData);
pData^ := FToken;
FDatas.Add(pData);
end;
end;
until(FRun>=FEnd);
Result := Boolean(FDatas.Count and 1) and (pData.Kind=ttNumber);
end;
end.
