类:TMathParser

出自：http://wagesys.googlecode.com/svn-history/r2/trunk/Source/MathParserUnit.pas

// 模块: 表达式解析器
// 创建时间:2003-10-19    作者:mrlong   版本:2.0
//
// 支持 Delphi XE 的版本
//
//说明:
//  类:TMathParser
//-----------------------------------------------------------------------------
// TokenType :  0 :运算符
//              1 :函数
//              2 :普通变量    {} 已变为说明符
//              3 :费用表变量  []
//              4 :工程表变量  {}
//              5 :普通数字    212
//-----------------------------------------------------------------------------
//  如果拥有者是TmlBudgetFile对象,则在解析时可通过域控制器搜索变量
//-----------------------------------------------------------------------------
//关键方法
//    解析表达式
//    参数:  expression 表达式 ;Awrong 非法字符串
//    function Parse(expression: string;Awrong:String=''): extended;
//    返回值:解析是否成功
//    property ParserError : Boolean read fParserError ;
//    可用的方法名
//    property FunctionName : TStrings read GetfunctionNames;
//
// 修改:
//   1.增加一个方法: jw()小数据进位,取整  By Mrlong 2004-9-26
//   2.增加一个方法: Round2(value), 取两位 Round3(value), 取三位 Round4(value), 取四位
//   3.修改了 MaxFuncNameLen 函数名称的位数5 改为 10
//   4.fCount : integer; 是目的是怎么处理??
//   5.语法增强:
//      ()表示代码的集合 [(t1;t2;t3).sc_rgf] = [t1.sc_rgf] + [t2.sc_rgf] + [t3.sc_rgf]
//
//   6.增加 Round0(), Round1(), Round5(),Round6() 的 函数 2005-12-5
//
//   7.在对表达式来说,有可能不是直接要计算出值,而是只显示表达式的内容
//       如 费用表内的计算表达式说明时要用到
//     修改内容:
//          line:1110 增加 '['的条件
//          line: 997 去掉部分不要的代码为了加快速度
//
//   8.处理不采用 [] 作为变量的作法,这样加快录入的速度 2006-11-15
//
//
//   9.我增加了if()的方法 格式 if(条件,真,假)   2007-3-1 V3.0.5
//     处理方式: 放在Parse 方法前处理掉单独处理,在生成键表后,Parse前处理,
//     所以生成键表过程中if()是方法,到了parse就不是方法了.
//
//  10.更改了，在去掉<>,与{}时，没有去掉<> 2007-9-18 ver=3.1.6
//  11.修改 GetExpressVar() 方法内Value取出值后必须初期化,否则第二次有问题 ver=3.1.9 2007-10-23
//  12.修改了第10条<>处理引起的if([!rcj_dy]>[rcj_ysj],0,12);时,>给去掉了.产生计算出错 ver=3.1.9 2007-10-29
//  13.修改支持Delphi XE 版本 作者 :龙仕云 2011-7-2
//
//
//

unit MathParserUnit;

interface
uses
  Windows, SysUtils, Messages, Classes, Controls, math
  ;

type

  TParseErrorEvent = procedure(Sender : TObject; ParseError : Integer) of object;

  //取出变量的地方,回调方法
  // 引用表时 myMathPaser.Parse(@DoGetValueByCode);
  TOnGetValueByCodeEvent = procedure(ACode:string; var AValue:string; var AFound:Boolean) of object;

//定义ExpressParse中的常量
const
  ParserStackSize = 30;
  MaxFuncNameLen  = 10;   // 5 by mrlong 有方法名大于5个字符的
  ExpLimit        = 11356;
  SqrLimit        = 1E2466;
  MaxExpLen       = 4;
  TotalErrors     = 10;
  ErrParserStack  = 1;
  ErrBadRange     = 2;
  ErrExpression   = 3;
  ErrOperator     = 4;
  ErrOpenParen    = 5;
  ErrOpCloseParen = 6;
  ErrInvalidNum   = 7;
  //引用自身或循环传递出错
  Erruseselfloop  = 8;
  //单位描述错误
  Errindanweimask = 9;
  //变量描述错误
  Errinvardefine  = 10;
  //表达式不能为空
  ErrEmpty        = 11;    //Add : Mrlong

type

  ErrorRange  = 0..TotalErrors;

  TokenTypes  = (Plus, Minus, Times, Divide, Expo, OParen, CParen, Num,
                 Func, EOL, Bad, ERR, Modu);

  TokenRec = record
    State : Byte;
    case Byte of
      0 : (Value : Extended);
      2 : (FuncName : String[MaxFuncNameLen]);
  end; { TokenRec }

  PExpressLink = ^TExpressLink;
  TExpressLink = record
    Tokenname : String;
    TokenType : Word;
    ExpressNext : pExpressLink;
  end;

  //定义检查链表
  PCheckLink = ^TCheckLink;
  TCheckLink = record
    VarName : String;
    VNext : PCheckLink;
  end;

type
  TMathParser = class(TObject)
  private
    fInput        : string;
    fLeftInput    : String;
    fOnParseError : TParseErrorEvent;
    fOnGetValueByCode  : TOnGetValueByCodeEvent;
    // add by mrlong
    fhasvar : Boolean ; //= True 表示有变量 如 [f2.g3] ,主要用到对变量的解析中
    fhasVariableChar : Boolean; //=True 表示变量要采用[] 来注明的
    // end add
  protected
    CurrToken : TokenRec;
    VaruseError : Word;
    MathError : Boolean;
    ExpressError : Boolean;
    DescribeError : Boolean;
    Stack : array[1..ParserStackSize] of TokenRec;
    StackTop : 0..ParserStackSize;
    TokenError : ErrorRange;
    TokenLen : Word;
    TokenType : TokenTypes;
    CheckHead : PCheckLink;
    fCount: integer;
    fFunctionCaption : TStringList;
    fFunctionName    : TStringList;

    function GotoState(Production : Word) : Word;
    function IsFunc(S : String) : Boolean;
    function IsVar(var Value : Extended) : Boolean;
    function NextToken : TokenTypes;

    function DeleteSpace(InputExpress: String): String;
    function CreateExpressLink(OrignalExpress : String) : PExpressLink;
    function IsFunction(s: String; d: String) : Boolean;
    function IsConstVar(s: String) : Boolean;
    function IsNum(s: String) :Boolean;
    function CreateExpress( ExpressHead : PExpressLink ) : String;
    procedure DeleteExpressLink(ExpressHead : PExpressLink);
    //取出数字
    function GetExpressVar(ExpressHead : PExpressLink) : PExpressLink;
    procedure GetVarByCode(ACode:string;var Value:Extended;var Found:Boolean);

    //下面的方法只用于取出字符串
    function GetExpressStrVar(ExpressHead : PExpressLink) : PExpressLink;
    procedure GetStrVarByCode(ACode:string;var Value:string;var Found:Boolean);

    //check
    procedure CheckLinkAdd(VarName : String);
    function  CompareLink(ExpressHead : PExpressLink) : Boolean;
    procedure DeleteCheckLink(CheckHead : PCheckLink);
    procedure Deletethevarname;
    //
    procedure Push(Token : TokenRec);
    procedure Pop(var Token : TokenRec);
    procedure Reduce(Reduction : Word);
    procedure Shift(State : Word);
    function Parse : Boolean;overload;

    function ParseIfExp(AStr:String):Boolean; // 1.2&23 的情况
    function ParseNum(AStr:String;var AValue:Extended):Boolean; //处理一个没有变量的表达式 如 2*3+1
    function  ExpressParse(Express : String; varname : String;
                          CheckHead : PCheckLink ) :Boolean; overload;

  public
    Position   : Word;
    ParseError : Boolean;
    ParseValue : Extended;
    Constructor Create();
    destructor Destroy; override;


    procedure Parse(ABackFun:TOnGetValueByCodeEvent); overload;

    //
    // 解析出表达式的内容,但不计算出最后的结果
    // AExp   : 为原始值的内容,如成功则返回为最后的内容
    // 返回值 : = True 表示成功
    //
    procedure ParseExpression(var AExp:String);

  published
    property OnParseError : TParseErrorEvent read FOnParseError write FOnParseError;
    property OnGetValueByCode : TOnGetValueByCodeEvent read fOnGetValueByCode write fOnGetValueByCode;
    property ParseString : string read FInput write FInput;
    property ParseLeftString : String read FLeftInput write FLeftInput;  //目的是为了处理死
    property FunctionCaption : TStringList read fFunctionCaption;
    property FunctionName    : TStringList read fFunctionName;
    property Count: integer read fCount write fCount;
    property hasVariableChar : Boolean read fhasVariableChar write fhasVariableChar;

  end;

implementation


function Round2(aValue: extended; aDigit: integer): extended;
begin
  aValue := aValue + 0.0000000001;
  if aDigit > 14 then
    result := RoundTo(aValue,-14)
  else
    result := RoundTo(aValue,-aDigit);
end;

function isEqual(Avalue,Bvalue:Extended):boolean;
begin
  if abs(Avalue-Bvalue)<0.00000001 then
    result := true
  else
    result := false;
end;

{ TMathParser }
constructor TMathParser.Create();
begin
  { defaults }
  FInput := '';
  fCount := 0;
  CheckHead := nil;
  fFunctionCaption := TStringList.Create;
  fFunctionName    := TStringList.Create;
  fhasVariableChar := True;

  //写入方法说明
  fFunctionCaption.Add('abs(B)=B的绝对值 ');
  fFunctionCaption.Add('atan(B) ');
  fFunctionCaption.Add('cos(D)  = D的余弦值,D以度为单位');
  fFunctionCaption.Add('tan(D)  = D的正切值,D以度为单位');
  fFunctionCaption.Add('cot(D)  = D的余切值,D以度为单位');
  fFunctionCaption.Add('exp(B)  = B的指数 ');
  fFunctionCaption.Add('ln(B)   = B的自然对数 ');
  fFunctionCaption.Add('round(B)= 四舍五入取整  ');
  fFunctionCaption.Add('sin(D)  = D的正弦值,D以度为单位');
  fFunctionCaption.Add('sqrt(B) = B的开方  ');
  fFunctionCaption.Add('sqr(B)  = B的平方 ');
  fFunctionCaption.Add('sqr3(B) = B的三次方 ');
  fFunctionCaption.Add('trunc(B) ');
  fFunctionCaption.Add('xsqz(B) = B向上取整 ');
  fFunctionCaption.Add('jw(B)   = 小数点进位取整');
  fFunctionCaption.Add('r0(B)= 四舍五入取0位  ');
  fFunctionCaption.Add('r1(B)= 四舍五入取1位  ');
  fFunctionCaption.Add('r2(B)= 四舍五入取2位  ');
  fFunctionCaption.Add('r3(B)= 四舍五入取3位  ');
  fFunctionCaption.Add('r4(B)= 四舍五入取4位  ');
  fFunctionCaption.Add('r5(B)= 四舍五入取5位  ');
  fFunctionCaption.Add('r6(B)= 四舍五入取6位  ');
  fFunctionCaption.Add('if(B)= 条件取值,B 条件,真,假 , 例如 if(1>2,1,2)'+#13#10 + '其中 >,=,!=,>= 分别表示大于,等于,不等于,大于等于。  '+#13#10+
                       ' & 为并且;| 为或者 '+#13#10 + '例如: if(1.2>[v.y1_a]&1.5>[v.y1_a],2.3,0)'+#13#10 + ' 意思就是 [v.y1_a]的值在1.2与1.5之间,则返回值=2.3,否则=0。 ' );


  fFunctionName.Add('abs()');
  fFunctionName.Add('atan()');
  fFunctionName.Add('cos()');
  fFunctionName.Add('tan()');
  fFunctionName.Add('cot()');
  fFunctionName.Add('exp()');
  fFunctionName.Add('ln()');
  fFunctionName.Add('round()');
  fFunctionName.Add('sin()');
  fFunctionName.Add('sqrt()');
  fFunctionName.Add('sqr()');
  fFunctionName.Add('sqr3()');
  fFunctionName.Add('trunc()');
  fFunctionName.Add('rxqz()');
  fFunctionName.Add('jw()');
  fFunctionName.Add('r0()');
  fFunctionName.Add('r1()');
  fFunctionName.Add('r2()');
  fFunctionName.Add('r3()');
  fFunctionName.Add('r4()');
  fFunctionName.Add('r5()');
  fFunctionName.Add('r6()');
  fFunctionName.Add('if()');
end;

function TMathParser.GotoState(Production : Word) : Word;
var
  State : Word;
begin
  GotoState := 0; // add by mrlong
  State := Stack[StackTop].State;
  if (Production <= 3) then
  begin
    case State of
      0 : GotoState := 1;
      9 : GotoState := 19;
      20 : GotoState := 28;
    end; { case }
  end
  else if Production <= 6 then
  begin
    case State of
      0, 9, 20 : GotoState := 2;
      12 : GotoState := 21;
      13 : GotoState := 22;
    end; { case }
  end
  else if (Production <= 8) or (Production = 100) then
  begin
    case State of
      0, 9, 12, 13, 20 : GotoState := 3;
      14 : GotoState := 23;
      15 : GotoState := 24;
      16 : GotoState := 25;
      40 : GotoState := 80;
    end; { case }
  end
  else if Production <= 10 then
  begin
    case State of
      0, 9, 12..16, 20, 40 : GotoState := 4;
    end; { case }
  end
  else if Production <= 12 then
  begin
    case State of
      0, 9, 12..16, 20, 40 : GotoState := 6;
      5 : GotoState := 17;
    end; { case }
  end
  else begin
    case State of
      0, 5, 9, 12..16, 20, 40 : GotoState := 8;
    end; { case }
  end;
end; { GotoState }

function TMathParser.IsFunc(S : String) : Boolean;
var
  P, SLen : Word;
  FuncName : string;
begin
  P := Position;
  FuncName := '';
  while (P <= Length(FInput)) and CharInSet(FInput[P], ['A'..'Z', 'a'..'z', '0'..'9',
    '_']) do
  begin
    FuncName := FuncName + FInput[P];
    Inc(P);
  end; { while }
  if Uppercase(FuncName) = S then
  begin
    SLen := Length(S);
    // FuncName 是有长度的,但录入的内容没有长度
    CurrToken.FuncName := ShortString(UpperCase(Copy(FInput, Position, SLen)));
    Inc(Position, SLen);
    IsFunc := True;
  end { if }
  else
    IsFunc := False;
end;
{ IsFunc }

function TMathParser.IsVar(var Value : Extended) : Boolean;
var
  VarName : string;
  VarFound : Boolean;
begin
  VarFound := False;
  VarName := '';
  while (Position <= Length(FInput)) and (AnsiChar(FInput[Position]) in ['A'..'Z',
    'a'..'z', '0'..'9', '_', #127..#255, '[', ']','@','#']) do
  begin
    VarName := VarName + FInput[Position];
    Inc(Position);
  end; { while }

   IsVar := VarFound;
end; { IsVar }

function TMathParser.NextToken : TokenTypes;
var
  NumString : String[80];
  TLen, NumLen : Word;
  Check : Integer;
  Ch: Char;
  Decimal : Boolean;
begin
   while (Position <= Length(FInput)) and (FInput[Position] = ' ') do
     Inc(Position);
   TokenLen := Position;
   if Position > Length(FInput) then
   begin
     NextToken := EOL;
     TokenLen := 0;
     Exit;
   end; { if }
   Ch := UpCase(FInput[Position]);
   if AnsiChar(Ch) in ['!'] then
   begin
      NextToken := ERR;
      TokenLen := 0;
      Exit;
   end; { if }

   NextToken := EOL; // add by mrlong 2008-5-26

   if AnsiChar(Ch) in ['0'..'9', '.'] then
   begin
     NumString := '';
     TLen := Position;
     Decimal := False;
     while (TLen <= Length(FInput)) and
           ((AnsiChar(FInput[TLen]) in ['0'..'9']) or
            ((FInput[TLen] = '.') and (not Decimal))) do
     begin
       NumString := NumString + ShortString(FInput[TLen]);
       if Ch = '.' then
         Decimal := True;
       Inc(TLen);
     end; { while }

     if (TLen = 2) and (Ch = '.') then
     begin
       NextToken := BAD;
       TokenLen := 0;
       Exit;
     end; { if }

     if (TLen <= Length(FInput)) and (UpCase(FInput[TLen]) = 'E') then
     begin
       NumString := NumString + 'E';
       Inc(TLen);
       if AnsiChar(FInput[TLen]) in ['+', '-'] then
       begin
         NumString := NumString + ShortString(FInput[TLen]);
         Inc(TLen);
       end; { if }
       NumLen := 1;
       while (TLen <= Length(FInput)) and (AnsiChar(FInput[TLen]) in ['0'..'9']) and
             (NumLen <= MaxExpLen) do
       begin
         NumString := NumString + ShortString(FInput[TLen]);
         Inc(NumLen);
         Inc(TLen);
       end; { while }
     end; { if }
     if NumString[1] = '.' then
       NumString := '0' + NumString;
     Val(string(NumString), CurrToken.Value, Check);
     if Check <> 0 then
      begin
         MathError := True;
         TokenError := ErrInvalidNum;
         Inc(Position, Pred(Check));
       end { if }
     else
       begin
         NextToken := NUM;
         Inc(Position, System.Length(NumString));
         TokenLen := Position - TokenLen;
       end; { else }
     Exit;
   end { if }
   else if  CharInSet(Ch,['A'..'Z', 'a'..'z', #127..#255, '[',']'])  then
   begin
     if IsFunc('ABS') or
        IsFunc('ATAN') or
        IsFunc('COS') or
        IsFunc('TAN') or
        isFunc('COT') or
        IsFunc('EXP') or
        IsFunc('LN') or
        IsFunc('ROUND') or
        IsFunc('SIN') or
        IsFunc('SQRT') or
        IsFunc('SQR') or
        IsFunc('SQR3') or
        IsFunc('TRUNC') or
        IsFunc('XSQZ') or
        IsFunc('JW') or
        isFunc('R0') or
        IsFunc('R1') or
        IsFunc('R2') or
        IsFunc('R3') or
        IsFunc('R4') or
        IsFunc('R5') or
        IsFunc('R6') then
     begin
       NextToken := FUNC;
       TokenLen := Position - TokenLen;
       Exit;
     end; { if }
     if IsFunc('MOD') then
     begin
       NextToken := MODU;
       TokenLen := Position - TokenLen;
       Exit;
     end; { if }
     if IsVar(CurrToken.Value)                    //是变量,取出值
       then begin
              NextToken := NUM;
              TokenLen := Position - TokenLen;
              Exit;
            end { if }
       else begin
              NextToken := BAD;
              TokenLen := 0;
              Exit;
            end; { else }
   end { if }
   else begin
     case Ch of
       '+' : NextToken := PLUS;
       '-' : NextToken := MINUS;
       '*' : NextToken := TIMES;
       '/' : NextToken := DIVIDE;
       '^' : NextToken := EXPO;
       '(' : NextToken := OPAREN;
       ')' : NextToken := CPAREN;
       else begin
         NextToken := BAD;
         TokenLen := 0;
         Exit;
       end; { case else }
     end; { case }
     Inc(Position);
     TokenLen := Position - TokenLen;
     Exit;
   end; { else if }
end; { NextToken }
procedure TMathParser.Pop(var Token : TokenRec);
begin
  Token := Stack[StackTop];
  Dec(StackTop);
end; { Pop }

procedure TMathParser.Push(Token : TokenRec);
begin
  if StackTop = ParserStackSize then
    TokenError := ErrParserStack
  else begin
    Inc(StackTop);
    Stack[StackTop] := Token;
  end; { else }
end; { Push }

function TMathParser.Parse : Boolean;
var
  FirstToken : TokenRec;
  Accepted : Boolean;
begin
  Position := 1;
  StackTop := 0;
  TokenError := 0;
  MathError := False;
  ParseError := False;
  Accepted := False;
  FirstToken.State := 0;
  FirstToken.Value := 0;
  Push(FirstToken);
  TokenType := NextToken;
  repeat
    case Stack[StackTop].State of
      0, 9, 12..16, 20, 40 : begin
        if TokenType = NUM then
          Shift(10)
        else if TokenType = FUNC then
          Shift(11)
        else if TokenType = MINUS then
          Shift(5)
        else if TokenType = OPAREN then
          Shift(9)
        else if TokenType = ERR then
          begin
             MathError := True;
             Accepted := True;
          end { else if }
        else begin
          TokenError := ErrExpression;
          Dec(Position, TokenLen);
        end; { else }
      end; { case of }
      1 : begin
        if TokenType = EOL then
          Accepted := True
        else if TokenType = PLUS then
          Shift(12)
        else if TokenType = MINUS then
          Shift(13)
        else begin
          TokenError := ErrOperator;
          Dec(Position, TokenLen);
        end; { else }
      end; { case of }
      2 : begin
        if TokenType = TIMES then
          Shift(14)
        else if TokenType = DIVIDE then
          Shift(15)
        else
          Reduce(3);
      end; { case of }
      3 : begin
       if TokenType = MODU then
         Shift(40)
       else
         Reduce(6);
      end; { case of }
      4 : begin
       if TokenType = EXPO then
         Shift(16)
       else
         Reduce(8);
      end; { case of }
      5 : begin
        if TokenType = NUM then
          Shift(10)
        else if TokenType = FUNC then
          Shift(11)
        else if TokenType = OPAREN then
          Shift(9)
        else
          begin
            TokenError := ErrExpression;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      6 : Reduce(10);
      7 : Reduce(13);
      8 : Reduce(12);
      10 : Reduce(15);
      11 : begin
        if TokenType = OPAREN then
          Shift(20)
        else
          begin
            TokenError := ErrOpenParen;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      17 : Reduce(9);
      18 : raise Exception.Create('Bad token state');
      19 : begin
        if TokenType = PLUS then
          Shift(12)
        else if TokenType = MINUS then
          Shift(13)
        else if TokenType = CPAREN then
          Shift(27)
        else
          begin
            TokenError := ErrOpCloseParen;
            Dec(Position, TokenLen);
          end;
      end; { case of }
      21 : begin
        if TokenType = TIMES then
          Shift(14)
        else if TokenType = DIVIDE then
          Shift(15)
        else
          Reduce(1);
      end; { case of }
      22 : begin
        if TokenType = TIMES then
          Shift(14)
        else if TokenType = DIVIDE then
          Shift(15)
        else
          Reduce(2);
      end; { case of }
      23 : Reduce(4);
      24 : Reduce(5);
      25 : Reduce(7);
      26 : Reduce(11);
      27 : Reduce(14);
      28 : begin
        if TokenType = PLUS then
          Shift(12)
        else if TokenType = MINUS then
          Shift(13)
        else if TokenType = CPAREN then
          Shift(29)
        else
          begin
            TokenError := ErrOpCloseParen;
            Dec(Position, TokenLen);
          end; { else }
      end; { case of }
      29 : Reduce(16);
      80 : Reduce(100);
    end; { case }
  until Accepted or (TokenError <> 0);
  if TokenError <> 0 then
  begin
      if TokenError = ErrBadRange then
        Dec(Position, TokenLen);
      if Assigned(FOnParseError)
        then FOnParseError(Self, TokenError);
  end; { if }
  if MathError or (TokenError <> 0) or ExpressError or DescribeError then
  begin
    ParseError := True;
    if Assigned(FOnParseError) then
      FOnParseError(Self, TokenError);
    ParseValue := 0;
    Result := False;
    //Exit;
  end
  else
    begin
      ParseError := False;
      ParseValue := Stack[StackTop].Value;
      Result := True;
  end;
end; { Parse }

procedure TMathParser.Reduce(Reduction : Word);
{ Completes a reduction }
var
  Token1, Token2 : TokenRec;
begin
  case Reduction of
    1 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      CurrToken.Value := Token1.Value + Token2.Value;
    end;
    2 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      CurrToken.Value := Token2.Value - Token1.Value;
    end;
    4 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      CurrToken.Value := Token1.Value * Token2.Value;
    end;
    5 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      if Token1.Value = 0 then
        MathError := True
      else
        CurrToken.Value := Token2.Value / Token1.Value;
    end;

    { MOD operator }
    100 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      if Token1.Value = 0 then
        MathError := True
      else
        CurrToken.Value := Round(Token2.Value) mod Round(Token1.Value);
    end;

    7 : begin
      Pop(Token1);
      Pop(Token2);
      Pop(Token2);
      if Token2.Value <= 0 then
        MathError := True
      else if (Token1.Value * Ln(Token2.Value) < -ExpLimit) or
              (Token1.Value * Ln(Token2.Value) > ExpLimit) then
        MathError := True
      else
        CurrToken.Value := Exp(Token1.Value * Ln(Token2.Value));
    end;
    9 : begin
      Pop(Token1);
      Pop(Token2);
      CurrToken.Value := -Token1.Value;
    end;
    11 : raise Exception.Create('Invalid reduction');
    13 : raise Exception.Create('Invalid reduction');
    14 : begin
      Pop(Token1);
      Pop(CurrToken);
      Pop(Token1);
    end;
    16 : begin
      Pop(Token1);
      Pop(CurrToken);
      Pop(Token1);
      Pop(Token1);

      // begin add by mrlong
      if UpperCase(string(Token1.FuncName))='R0' then
      begin
        Currtoken.Value := Round2(CurrToken.Value,0);
      end
      else if CompareText(string(Token1.FuncName),'R1')=0 then
      begin
        Currtoken.Value := Round2(CurrToken.Value,1);
      end
      else if CompareText(string(Token1.FuncName),'R2')=0 then  //进位
      begin
        Currtoken.Value := Round2(CurrToken.Value,2);
      end
      else if CompareText(string(Token1.FuncName),'R3')=0 then
      begin
        Currtoken.Value := Round2(CurrToken.Value,3);
      end
      else if CompareText(string(Token1.FuncName),'R4')=0 then
      begin
        CurrToken.Value := Round2(CurrToken.Value,4);
      end
      else if CompareText(string(Token1.FuncName),'R5')=0 then
      begin
        Currtoken.Value := Round2(CurrToken.Value,5);
      end
      else if CompareText(string(Token1.FuncName),'R6')=0 then
      begin
        Currtoken.Value := Round2(CurrToken.Value,6);
      end
      //
      // if 的处理方法放到了 CreateExpress 方法处理
      //
      else if CompareText(string(Token1.FuncName),'ABS')=0 then
        CurrToken.Value := Abs(CurrToken.Value)
      else if CompareText(string(Token1.FuncName),'ATAN')=0 then
        CurrToken.Value := ArcTan(CurrToken.Value)
      else if CompareText(string(Token1.FuncName),'COS')=0 then
      begin
         if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := Cos((CurrToken.Value/180)*PI);  //角度改为弧度
      end {...if Token1.FuncName = 'SIN' }
      else if CompareText(string(Token1.FuncName),'TAN')=0 then
      begin
         if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := tan((CurrToken.Value/180)*PI)
      end {...if Token1.FuncName = 'TAN' }
      else if CompareText(string(Token1.FuncName),'COT')=0 then
      begin
        if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := cot((CurrToken.Value/180)*PI)
      end
      else if CompareText(string(Token1.FuncName),'EXP')=0 then
      begin
        if (CurrToken.Value < -ExpLimit) or (CurrToken.Value > ExpLimit) then
          MathError := True
        else
          CurrToken.Value := Exp(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'XSQZ')=0 then
      begin
        if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
          MathError := True
        else
          CurrToken.Value := ceil(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'LN')=0 then
      begin
        if CurrToken.Value <= 0 then
          MathError := True
        else
          CurrToken.Value := Ln(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'ROUND')=0 then
      begin
        if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
          MathError := True
        else
          CurrToken.Value := Round(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'SIN')=0 then
      begin
         if (CurrToken.Value < -9E18) or (CurrToken.Value > 9E18) then
            MathError := True
         else
            CurrToken.Value := Sin((CurrToken.Value/180)*PI);
      end {...if Token1.FuncName = 'SIN' }
      else if CompareText(string(Token1.FuncName),'SQRT')=0 then
      begin
        if CurrToken.Value < 0 then
          MathError := True
        else
          CurrToken.Value := Sqrt(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'SQR')=0 then
      begin
        if (CurrToken.Value < -SQRLIMIT) or (CurrToken.Value > SQRLIMIT) then
          MathError := True
        else
          CurrToken.Value := Sqr(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'SQR3')=0 then
      begin
        if (CurrToken.Value < -SQRLIMIT) or (CurrToken.Value > SQRLIMIT) then
          MathError := True
        else
          CurrToken.Value := Sqr(CurrToken.Value)*CurrToken.Value; //三次方
      end
      else if CompareText(string(Token1.FuncName),'TRUNC')=0 then
      begin
        if (CurrToken.Value < -1E9) or (CurrToken.Value > 1E9) then
          MathError := True
        else
          CurrToken.Value := Trunc(CurrToken.Value);
      end
      else if CompareText(string(Token1.FuncName),'JW')=0 then
      begin
        if Abs(CurrToken.Value) > Int(Abs(CurrToken.Value ) + 0.000000001)   then
        begin
          if  CurrToken.Value > 0 then
            CurrToken.Value := Int(CurrToken.Value) + 1
          else if CurrToken.Value < 0 then
            CurrToken.Value := (Int(Abs(CurrToken.Value)) + 1)*-1
          else
            CurrToken.Value := 0;
        end;
      end;



    end;
    3, 6, 8, 10, 12, 15 : Pop(CurrToken);
  end; { case }
  CurrToken.State := GotoState(Reduction);
  Push(CurrToken);
end; { Reduce }

procedure TMathParser.Shift(State : Word);
begin
  CurrToken.State := State;
  Push(CurrToken);
  TokenType := NextToken;
end; { Shift }


{扩展功能}

function TMathParser.DeleteSpace(InputExpress: String) : String;
var
  Flags : TReplaceFlags;
begin
  DescribeError := False;
  //1.替换%和‰
  Flags := [rfReplaceAll];
  //先查找，要快很多，毕竟公式里%不多
  if Pos('%',InputExpress) > 0 then
    InputExpress := StringReplace(InputExpress,'%','*(0.01)',Flags);
  if Pos('‰',InputExpress) > 0 then
    InputExpress := StringReplace(InputExpress,'‰','*(0.001)',Flags);

  Result:= InputExpress;
end;

//处理原始表达式
function TMathParser.CreateExpressLink(OrignalExpress : String) : PExpressLink;
var
  head : PExpressLink;    //键头
  p,pnext : PExpressLink;
  ESLen : Word;
  Eposition: Word;
  STemp : String;
  ch : Char;
  tp : Word;
  hadif : Boolean; //= True 表示正在处理 if 的方法
begin
  fhasvar := False; //add by mrlong
  hadif   := False;

  ESLen := Length(OrignalExpress);
  Eposition := 1;
  p := nil;
  head := nil;
  while (Eposition <= EsLen) do
  begin
    ch := OrignalExpress[Eposition];
    case ch of
      '(',')','+','-','*','/' : //基本语法
      begin
        if head = nil then
        begin
          New(head);
          head^.Tokenname := '';
          head^.Tokenname := head^.Tokenname + OrignalExpress[Eposition];
          head^.TokenType := 0;
          head^.ExpressNext := nil;
          p := head;
          inc(Eposition);
        end
        else  begin
          New(pnext);
          pnext^.Tokenname := '';
          pnext^.Tokenname := pnext^.Tokenname + OrignalExpress[Eposition];
          pnext^.TokenType := 0;
          pnext^.ExpressNext := nil;
          p^.ExpressNext := pnext;
          p := pnext;
          inc(Eposition);
          if (ch=')') and hadif then hadif := False; //不是 if 了
        end;
      end;
      '[' :   //变量
      begin
        STemp := '';
        inc(Eposition);
        repeat
          STemp := STemp + OrignalExpress[Eposition];
          inc(Eposition);
        until AnsiChar(OrignalExpress[Eposition]) in [']'];

        //STemp 可能要进行二次的分析出来,可能有 [(t1;t2;t3).sc_rgf] 的变量,这变量要从这取出来
        //还是到我们的底层类内进行,我认为在底层类内更全面点,有助于对
        // 最后处理成 [t1.sc_rgf] + [t2.sc_rgf] + [t3.sc_rgf];

        inc(Eposition);
        fhasvar := True; //add by mrlong //说明有变量,要进行变量的替换
        if head = nil then
        begin
          New(head);
          head^.Tokenname := STemp;
          head^.TokenType := 4;
          head^.ExpressNext := nil;
          p := head;
        end
        else begin
          New(pnext);
          pnext^.Tokenname := STemp;
          pnext^.TokenType := 4;
          pnext^.ExpressNext := nil;
          p^.ExpressNext := pnext;
          p := pnext;
        end;
      end;
      '{' :  //变量注释,当常量,只要是在表达式不计算只是解释时用的
      begin
        STemp := '';
        inc(Eposition);
        repeat
          STemp := STemp + OrignalExpress[Eposition];
          inc(Eposition);
        until AnsiChar(OrignalExpress[Eposition]) in ['}'];

        inc(Eposition);
        if head = nil then
        begin
          //New(head);
          //head^.Tokenname := format('{%s}',[STemp]);
          //head^.TokenType := 5;
          //head^.ExpressNext := nil;
          //p := head;
        end
        else begin
          //New(pnext);
          //pnext^.Tokenname := format('{%s}',[STemp]);
          //pnext^.TokenType := 5;
          //pnext^.ExpressNext := nil;
          //p^.ExpressNext := pnext;
          //p := pnext;
        end;
      end;
      else  //begin
        if hadif and (AnsiChar(ch) in ['>','!','=',',','&','|']) then
        begin
          New(pnext);
          pnext^.Tokenname := ch;
          pnext^.TokenType := 5;  //做为常量
          pnext^.ExpressNext := nil;
          p^.ExpressNext := pnext;
          p := pnext;
          inc(Eposition);
        end
        else begin
          // may be function,var,const var,num
          STemp := '';
          repeat
            STemp := STemp + OrignalExpress[Eposition];
            inc(Eposition);
          // upate 增加 [  的字符串条件 2006-1-16
          until ( AnsiChar(OrignalExpress[Eposition]) in ['(',')','+','-','*','/','[','{']) or (Eposition > ESLen)or
                ( hadif and ( AnsiChar(OrignalExpress[Eposition]) in ['>','!','=',',','&','|']));


          if IsFunction(Stemp,'IF') then
          begin
            hadif := True; //下面的内容是if方法
            tp := 1;
          end
          else if IsFunction(STemp,'ABS') or
             IsFunction(STemp,'ATAN') or
             IsFunction(STemp,'COS') or
             IsFunction(STemp,'TAN') or
             IsFunction(STemp,'COT') or
             IsFunction(STemp,'EXP') or
             IsFunction(STemp,'LN') or
             IsFunction(STemp,'ROUND') or
             IsFunction(STemp,'SIN') or
             IsFunction(STemp,'SQRT') or
             IsFunction(STemp,'SQR') or
             IsFunction(STemp,'SQR3') or
             IsFunction(STemp,'TRUNC') or
             IsFunction(STemp,'XSQZ') or
             IsFunction(Stemp,'JW') or
             IsFunction(Stemp,'R0') or
             IsFunction(Stemp,'R1') or
             IsFunction(Stemp,'R2') or
             IsFunction(Stemp,'R3') or
             IsFunction(Stemp,'R4') or
             IsFunction(Stemp,'R5') or
             IsFunction(Stemp,'R6') then  tp := 1

          else
          begin
            if IsNum(STemp) then
              tp := 5
            else begin
              tp := 2;
              if not fhasVariableChar then  //如不采用[]注明时(工程量内用),说明这个就是变量
                fhasvar := True;
            end;
          end;

          if head = nil then
          begin
            New(head);
            //工程量计算式不支持 Q*.1*.1
            if (tp = 5) and (STemp[1] = '.') then
              STemp := '0' + STemp;
            head^.Tokenname := STemp;
            head^.TokenType := tp;
            head^.ExpressNext := nil;
            p := head;
          end
          else  begin
            New(pnext);
            //工程量计算式不支持 Q*.1*.1
            if (tp = 5) and (STemp[1] = '.') then
              STemp := '0' + STemp;
            pnext^.Tokenname := STemp;
            pnext^.TokenType := tp;
            pnext^.ExpressNext := nil;
            p^.ExpressNext := pnext;
            p := pnext;
          end;
        end;
    end;
  end;
  Result:= head;
end;

function TMathParser.IsNum(s: String) :Boolean;
var
  ESLen : Word;
  pos : Word;
  ch : Char;
  i : Integer;
begin
  ESLen := Length(s);
  pos := 1;i := 0;
  while pos <= ESLen do
  begin
    ch := s[pos];
    if not (AnsiChar(ch) in ['0'..'9','.'] )then
      i := i + 1;
    inc(pos);
  end;
  if i = 0 then IsNum := True
  else IsNum := False;
end;

function TMathParser.IsConstVar(s: String) : Boolean;
begin
  IsConstVar := False;
end;

function TMathParser.IsFunction(s: String; d: String) : Boolean;
begin
  if UpperCase(s) = d then
    IsFunction := True
  else
    IsFunction := False;
end;

//将键表变成一个字符串
function TMathParser.CreateExpress( ExpressHead : PExpressLink ) : String;
var
  p : PExpressLink;
  STemp : String;
  myStr : String;
  myValue : Array[0..2] of String;  //表达式,真值,假值
  myv : Extended;
begin
  STemp := '';
  p := ExpressHead;

  while  p <> nil do
  begin
    //
    //1.if 方法
    //
    if (CompareText(p.Tokenname,'if') = 0) and
        Assigned(p^.ExpressNext) then
    begin
      myStr := '';
      p := p^.ExpressNext; // (
      p := p^.ExpressNext; //
      while (p<>nil) and (p^.Tokenname <> ')') do
      begin
        myStr := myStr +  p^.Tokenname;   // 是if() 的内容
        p := p^.ExpressNext;
      end;

      //先将值分到数据内 myValue[0]   myVlaue[1] myVlaue[2]
      //                    条件         真值      假值

      if Pos(',',myStr)>0 then
      begin
        myValue[0] := Copy(myStr,1,Pos(',',myStr)-1);
        myStr := Copy(myStr,Pos(',',myStr)+1,maxint);
        if Pos(',',myStr)>0 then
        begin
          myValue[1] := Copy(myStr,1,Pos(',',myStr)-1);
          myValue[2] := Copy(myStr,Pos(',',myStr)+1,maxint);
        end
        else begin
          STemp := STemp + myStr;
          if not Assigned(p) then break;
          p := p^.ExpressNext;
          Continue;
        end;
      end
      else begin
         STemp := STemp + myStr;
         if not Assigned(p) then break;
         p := p^.ExpressNext;
         Continue;
      end;

      //
      // 解释正则表达式 12>5&4<5 的情况
      //
      if ParseIfExp(myValue[0]) then
      begin
        if ParseNum(myValue[1],myv) then
          Stemp := STemp + floattostr(myv)
        else
          Exit;
      end
      else  begin
        if ParseNum(myValue[2],myv) then
          Stemp := STemp + floattostr(myv)
        else
          Exit;
      end;

      if not Assigned(p) then break;
      p := p^.ExpressNext;

    end
    else begin
      STemp := STemp + p^.Tokenname;
      p := p^.ExpressNext;
    end;
  end;

  Result := STemp;
end;

//删除键表
procedure TMathParser.DeleteExpressLink(ExpressHead : PExpressLink);
var
  p,p1 : PExpressLink;
begin
  p:= ExpressHead;
  if p <> nil then
  begin
    while p^.ExpressNext <> nil do
    begin
      p1:= p^.ExpressNext;
      Dispose(p);
      p := p1;
    end;
    Dispose(p);
  end;
end;

//----------------------------
//  Express:表达式
//  VarName : 非法字符集
//-----------------------------
function TMathParser.ExpressParse(Express : String; varname : String;
                          CheckHead : PCheckLink ) :Boolean;
var
  Head : PExpressLink;
begin
  ParseError := False;
  Head := CreateExpressLink(DeleteSpace(Express));
  //
  // 现在不处理这个  2007-3-1
  //CheckLinkAdd(varname);             //非法字符
  //
  if CompareLink(Head) then
    VaruseError := VaruseError + 1;
  Head := GetExpressVar(Head);       //换算变量
  ParseString := CreateExpress(Head);//替换成纯数字表达式的字符串,或处理特殊的方法

  DeleteExpressLink(Head);           //删除键表

  if (ParseString <> '') and not ParseError then
  begin
    Result := Parse
  end
  else begin
   if Assigned(FOnParseError)
      then FOnParseError(Self, ErrEmpty);
    ParseError := True;
    ParseValue := 0;
    Result := False;
  end;
end;

//变量换算
function  TMathParser.GetExpressVar(ExpressHead : PExpressLink) : PExpressLink;
var
  phead,nodepre,nodethis : PExpressLink;
  Value : Extended;
  ValFound: Boolean;
begin
  ExpressError := False;
  phead := ExpressHead;

  if (VaruseError = 0) and (ExpressError = False)  and (phead <> nil) then
  begin
    nodethis := phead;
    Value    := 0.0;
    repeat
      case  nodethis^.TokenType of
        4:  //费用表变量[] 2=普通变量
          begin
            GetVarByCode(nodethis^.Tokenname,Value,ValFound);
            if ValFound then
            begin
              nodethis^.TokenType := 5;
              nodethis^.Tokenname := floattostr(Value);
            end
            else begin
              ExpressError := True;
              break;
            end;
          end;
        2:
          begin
            //
            // 只有 fhasVariableChar = False 才处理 2
            //
            // 可能if(1=2,3,4), 是 1=2,3,4就是变量,这时会增加查找的过程过多
            //
            if not fhasVariableChar then
            begin
              GetVarByCode(nodethis^.Tokenname,Value,ValFound);
              if ValFound then
              begin
                nodethis^.TokenType := 5;
                nodethis^.Tokenname := floattostr(Value);
              end
              else
                nodethis^.TokenType := 5;  //如没有找到,则当前是常量处理了. 2007-4-2

            end;
          end;
      end; // end case
      nodepre := nodethis;
      nodethis := nodepre^.ExpressNext;
      Value := 0.0;
    until (nodethis  = nil) or (VaruseError <> 0) or ExpressError;
  end; // end if

  if (VaruseError = 0) and (ExpressError = False) then
    Result := ExpressHead
  else begin
    if Assigned(FOnParseError)
        then FOnParseError(Self, Erruseselfloop);
    DeleteExpressLink(phead);
    Result := nil;
  end;

end;

procedure TMathParser.Deletethevarname;
var
  p,p1 : PCheckLink;
begin
  p1 := nil;
  p:= CheckHead;
  if p <> nil then
  begin
    if p^.VNext = nil then
    begin
      Dispose(p);
      CheckHead := nil;
    end
    else begin
      while p^.VNext <> nil do
      begin
        p1:= p ;
        // Dispose(p);
        p := p1^.VNext;
        //Dispose(p1); //add by mrlong  为什么这??
      end;
      if Assigned(p1) then
        p1^.VNext := nil;
      Dispose(p);
    end;
  end;
end;

procedure TMathParser.CheckLinkAdd(VarName : String);
var
  node,pnode : PCheckLink;
begin
  if CheckHead = nil then
    begin
      New(node);
      node^.VarName := VarName;
      node^.VNext := nil;
      CheckHead := node;
    end
  else
    begin
      pnode := CheckHead;
      while pnode^.VNext <> nil do pnode := pnode^.VNext;
      New(node);
      node^.VarName := VarName;
      node^.VNext := nil;
      pnode^.VNext := node;
    end;
end;

function TMathParser.CompareLink(ExpressHead : PExpressLink) : Boolean;
var
  EHead  : PExpressLink;
  CHead : PCheckLink;
  num : Word;
begin
  num := 0;
  EHead := ExpressHead;
  if EHead <> nil then
  begin
    repeat
      if (EHead^.TokenType = 3) or (EHead^.TokenType = 4) then
      begin
        CHead := CheckHead;
        if CHead <> nil then
        begin
          repeat
            if CHead^.VarName = EHead^.Tokenname then num := num +1;
            CHead := CHead^.VNext;
          until CHead = nil;
        end;
      end;
      EHead := EHead^.ExpressNext;
    until EHead = nil;
  end;
  if num = 0 then Result := False
  else Result := True;
end;

procedure TMathParser.DeleteCheckLink(CheckHead : PCheckLink);
var
  p,p1 : PCheckLink;
begin
  p:= CheckHead;
  if p <> nil then
  begin
    repeat
      p1 := p^.VNext;
      Dispose(p);
      p := p1;
    until p = nil;
  end;
end;


destructor TMathParser.Destroy;
begin
  fFunctionCaption.Free;
  fFunctionName.Free;
  inherited;
end;

procedure TMathParser.Parse(ABackFun: TOnGetValueByCodeEvent);
begin
  fOnGetValueByCode := ABackFun;
  VaruseError := 0;
  ExpressParse(ParseString,ParseLeftString,CheckHead) ;
  DeleteCheckLink(CheckHead);  //清空键表
  CheckHead := nil;
end;

procedure TMathParser.ParseExpression(var AExp:String);
var
  Head,p  : PExpressLink;
  MyStr : String;
begin
  VaruseError := 0;
  Head := CreateExpressLink(AExp);
  CheckLinkAdd('');             //非法字符,无非法字符
  if CompareLink(Head) then
    VaruseError := VaruseError + 1;
  if fhasvar then
    Head := GetExpressStrVar(Head);//GetExpressVar(Head);       //换算变量

  if (VaruseError = 0 ) and (ExpressError = False)  then
  begin
    //将键表转化为字符串
    p := Head;
    MyStr := '';
    while p <> nil do
    begin
      MyStr := MyStr + p^.Tokenname;
      p := p^.ExpressNext;
    end;
    AExp := MyStr
  end;

  DeleteExpressLink(Head);           //删除键表
  Deletethevarname;

end;

function TMathParser.ParseIfExp(AStr: String): Boolean;
type
  pMyStrRec = ^TmyStrRec;
  TmyStrRec = record
    fStr : String;
  end;

var
  i,c : integer;
  myList : TList;
  myand : Boolean; //如=True 表示 and关系,否则是 or 关系
  myPstr : pMyStrRec;
  myStr : String;
  myExp : array[0..2] of String;
  myChar : Char;
  myb : Boolean;
  myiback : Boolean;  // = True 则不处理
  myv1,myv2 : Extended;
begin

//
//   & 表示并且 | 表示或者
//
// 说明,只能全部是 & 或全部是 |
//
//  >= 时怎么处理,
//
//
//
  Result := False;
  myList := TList.Create;
  try
    myand := Pos('&',AStr) > 0;
    if myand then myChar := '&' else myChar := '|';
    myiback := False;
    for i:=1 to Length(AStr) do
    begin
      if myiback then
      begin
        myiback := False;
        Continue;
      end;
      if (AStr[i] = myChar) or (AnsiChar(AStr[i]) in ['>','=','!']) then // @ 为<
      begin
        new(myPstr); myPstr^.fStr := myStr;
        myList.Add(myPstr);
        mystr := '';
        //增加操作符
        if (AnsiChar(AStr[i]) in ['>','=']) then
        begin
          new(myPstr);myPstr^.fStr := AStr[i];
          myList.Add(myPstr);
          if (AStr[i] = '>') and ((i+1)<Length(AStr)) and
             (AStr[i+1]='=') then
          begin
            myPstr^.fStr := '>=';  //这时的i 要跳一格
            myiback := True; //下一个i不处理
          end;
        end
        else if (AnsiChar(AStr[i]) in ['!']) and ((i+1)<Length(AStr)) and
                (AStr[i+1]='=') then
        begin
          new(myPstr);myPstr^.fStr := '!=';
          myList.Add(myPstr);
          myiback := True;  //与上面一样
        end;
      end
      else
        mystr := mystr + AStr[i];
    end;
    if mystr <> '' then begin
      new(myPstr); myPstr^.fStr := mystr;
      myList.Add(myPstr);
    end;

    //
    // 三个一比较
    //
    c := myList.Count div 3;
    if c = 0 then Exit;
    for i:=0 to c -1 do
    begin

      myPstr := myList.Items[i*3+0];  myExp[0] := myPstr^.fStr;
      myPstr := myList.Items[i*3+1];  myExp[1] := myPstr^.fStr;
      myPstr := myList.Items[i*3+2];  myExp[2] := myPstr^.fStr;

      // myExp[0],myExp[2] 有可能是表达式
      if not ParseNum(myExp[0],myv1) then Exit;
      if not ParseNum(myExp[2],myv2) then Exit;

      myb := False;
      //大于值
      if myExp[1] = '>' then
        myb := myv1 > myv2
      else if myExp[1] = '=' then
        myb := isEqual(myv1,myv2)
      else if myExp[1] = '!=' then
        myb := myv1 <> myv2
      else if myExp[1] = '>=' then
        myb := myv1 >= myv2;

      if myb and not myand then
      begin
        Result := True;
        Exit;
      end
      else if not myb and myand then begin
        Exit;
      end;

    end;

    //myand =True 的情况 运行完成,发现没有 false ,则返回 True
    if myand then Result := True;

  finally
    for i:=0 to myList.Count -1 do
    begin
      myPstr := myList.Items[i];
      Dispose(myPstr);
    end;
    myList.Free;
  end;
end;


function TMathParser.ParseNum(AStr: String;var AValue:Extended): Boolean;
var
  myStr : String;
begin
  AValue := 0;
  Result := True;
  myStr := ParseString;
  ParseString := AStr;
  try
   if ParseString <> '' then
    begin
      if Parse then
      begin
        AValue := ParseValue;
        Result := True;
      end
      else begin
        ParseError := True;
        Result := False;
      end
    end
  finally
    ParseString := myStr;
  end;
end;


procedure TMathParser.GetStrVarByCode(ACode: string; var Value: string;
  var Found: Boolean);
var
  myStr : string;
  myFound : Boolean;
begin
  Found := False;
  //这地方是取出变量来
  if Assigned(fOnGetValueByCode) then
  begin
    myFound := False;
    fOnGetValueByCode(ACode,myStr,myFound);
    if myFound then
    begin
      Found := True;
      Value := myStr;
    end;
  end;
end;

procedure TMathParser.GetVarByCode(ACode: string; var Value: Extended;
  var Found: Boolean);
var
  myStr : string;
  myFound : Boolean;
begin
  Found := False;
  myFound:= False;
  GetStrVarByCode(ACode,myStr,myFound);
  if myFound then
  begin
    Found := myFound;
    Value := StrToFloatDef(myStr,0);
  end;

end;

function TMathParser.GetExpressStrVar(
  ExpressHead: PExpressLink): PExpressLink;
var
  phead,nodepre,nodethis : PExpressLink;
  Value : string;
  ValFound: Boolean;
begin
  ExpressError := False;
  phead := ExpressHead;

  if (VaruseError = 0) and (ExpressError = False)  and (phead <> nil) then
  begin
    nodethis := phead;
    Value    := '';
    repeat
      case  nodethis^.TokenType of
        4:  //费用表变量[] 2=普通变量
          begin
            GetStrVarByCode(nodethis^.Tokenname,Value,ValFound);
            if ValFound then
            begin
              nodethis^.TokenType := 5;
              nodethis^.Tokenname := Value;
            end
            else begin
              ExpressError := True;
              break;
            end;
          end;
        2:
          begin
            //
            // 只有 fhasVariableChar = False 才处理 2
            //
            // 可能if(1=2,3,4), 是 1=2,3,4就是变量,这时会增加查找的过程过多
            //
            if not fhasVariableChar then
            begin
              GetStrVarByCode(nodethis^.Tokenname,Value,ValFound);
              if ValFound then
              begin
                nodethis^.TokenType := 5;
                nodethis^.Tokenname := Value;
              end
              else
                nodethis^.TokenType := 5;  //如没有找到,则当前是常量处理了. 2007-4-2

            end;
          end;
      end; // end case
      nodepre := nodethis;
      nodethis := nodepre^.ExpressNext;
      Value := '';
    until (nodethis  = nil) or (VaruseError <> 0) or ExpressError;
  end; // end if

  if (VaruseError = 0) and (ExpressError = False) then
    Result := ExpressHead
  else begin
    if Assigned(FOnParseError)
        then FOnParseError(Self, Erruseselfloop);
    DeleteExpressLink(phead);
    Result := nil;
  end;

end;




end.