您现在的位置:首页 >> 基础算法 >> window基础 >> 内容

Delphi四则混合运算程序的代码

时间:2011/9/3 15:38:06 点击:

  核心提示: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.

作者:Seamour 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
  • 盒子文章 技术支持:深圳市麟瑞科技有限公司(www.2ccc.com) © 2024 版权所有 All Rights Reserved.
  • 粤ICP备10103342号-1