编辑

dede 的源代码 3.10b

unit FatExpression;
{Source files:
  FatExpression.pas (2002-2-19 19:38:20)}

interface

uses
  Math {
    A:Power},
  SysUtils {
    A:Trim, T:Exception, A:.Exception, A:Exception.CreateFmt, A:FreeAndNil,
    A:Exception.Create, A:UpperCase},
  Dialogs,
  Classes {
    T:TList, T:TStringList, T:TComponent, A:.TComponent,
    A:TComponent.DefineProperties, A:TComponent.Loaded,
    A:TComponent.Notification, A:TComponent.ReadState,
    A:TComponent.SetName, A:TComponent.UpdateRegistry,
    A:TComponent.ValidateRename, A:TComponent.WriteState,
    A:TComponent.QueryInterface, A:TComponent.BeforeDestruction,
    A:TComponent.SafeCallException, A:TPersistent.AssignTo,
    A:TPersistent.Assign, A:RegisterComponents, A:.TList, A:TList.Get,
    A:TList.Delete, A:TList.Add, A:TList.Insert, A:.TStringList,
    A:TComponent.Create, A:TComponent.Destroy},
  SysInit,
  System {
    T:TObject, T:String, T:AnsiString, T:Double, T:Integer, T:Boolean,
    A:.TObject, A:TObject.SafeCallException, A:TObject.AfterConstruction,
    A:TObject.BeforeDestruction, A:TObject.Dispatch,
    A:TObject.DefaultHandler, A:TObject.NewInstance,
    A:TObject.FreeInstance, A:TObject.Destroy, A:Pos, A:@LStrPos,
    A:@LStrCmp, A:TObject.Create, A:@ClassCreate, A:@AfterConstruction,
    A:TObject.Free, A:@BeforeDestruction, A:@ClassDestroy, A:@LStrAsg,
    A:@LStrClr, A:@HandleFinally, A:Val, A:@ValExt, A:@LStrAddRef,
    A:Length, A:@LStrLen, A:Exit, A:False, A:Inc, A:True, A:@LStrFromChar,
    A:@RaiseExcept, A:@LStrLAsg, A:@LStrCat, A:@LStrArrayClr, A:Assigned,
    A:Dec, A:Break, A:@TryFinallyExit, A:SetLength, A:@DynArrayHigh,
    A:High, A:@DynArraySetLength, A:@IsClass, A:@DynArrayClear, A:Round,
    A:@ROUND, A:Copy, A:@LStrCopy, A:Delete, A:@LStrDelete, A:Continue,
    A:@FinalizeArray};

const
  ttNone = TTokenType($00);

  ttNumeric = TTokenType($01);

  ttParenthesis = TTokenType($02);

  ttOperation = TTokenType($03);

  ttString = TTokenType($04);

  ttParamDelimitor = TTokenType($05);

type
  TTokenType=$0..$5;

const
  eoInternalFirst = TEvaluateOrder($00);

  eoEventFirst = TEvaluateOrder($01);

type
  TEvaluateOrder=$0..$1;

  TOnEvaluate=procedure(Sender: System.TObject; Eval: System.AnsiString;
    Args: array[$0..-$1] of System.Double; _Dv_: $0..-$1;
    ArgCount: System.Integer; var Value: System.Double;
    var Done: System.Boolean) of object;

  TExpToken=class ({T#5}System.TObject) 
  private
    FText: System.AnsiString;
    FTokenType: TTokenType;
  public
    property Text:System.AnsiString read FText{0x140};
    property TokenType:TTokenType read FTokenType{0x141};
  end;

  TExpParser=class ({T#5}System.TObject) 
  protected
    FExpression: System.AnsiString;
    FTokens: Classes.TList;
    FPos: System.Integer;
  private
    procedure Clear{8A} (Self: TExpParser);
    function GetToken{8F} (Self: TExpParser; Index: System.Integer):
      TExpToken;
    procedure SetExpression{8C} (Self: TExpParser;
      Value: System.AnsiString);
  public
    constructor Create{84} (Self: TExpParser; _Dv_: false..true);
    destructor Destroy{87} (Self: TExpParser; _Dv_: false..true); override{;
      virtual};
    function ReadFirstToken{93} (Self: TExpParser): TExpToken;
    function ReadNextToken{9D} (Self: TExpParser): TExpToken;
    function TokenCount{A5} (Self: TExpParser): System.Integer;
    property Tokens[Index: System.Integer]: TExpToken
      read TExpParser.GetToken{0x8F};
    property TokenList:Classes.TList read FTokens{0x145};
    property Expression:System.AnsiString read FExpression{0x144}
      write TExpParser.SetExpression{0x8C};
  end;

  TExpNode=class ({T#5}System.TObject) 
  protected
    FOwner: System.TObject;
    FParent: TExpNode;
    FChildren: Classes.TList;
    FTokens: Classes.TList;
    FLevel: System.Integer;
    FToken: TExpToken;
    FOnEvaluate: TOnEvaluate;
  private
    function GetToken{EB} (Self: TExpNode; Index: System.Integer):
      TExpToken;
    function GetChildren{CE} (Self: TExpNode; Index: System.Integer):
      TExpNode;
    function FindLSOTI{D2} (Self: TExpNode): System.Integer;
    function ParseFunction{BD} (Self: TExpNode): System.Boolean;
    procedure RemoveSorroundingParenthesis{B3} (Self: TExpNode);
    procedure SplitToChildren{C7} (Self: TExpNode;
      TokenIndex: System.Integer);
    function Evaluate{DE} (Self: TExpNode): System.Double;
    property Children[Index: System.Integer]: TExpNode
      read TExpNode.GetChildren{0xCE};
  public
    constructor Create{A8} (Self: TExpNode; _Dv_: false..true;
      AOwner: System.TObject; AParent: TExpNode; Tokens: Classes.TList);
    destructor Destroy{AF} (Self: TExpNode; _Dv_: false..true); override{;
      virtual};
    procedure Build{BA} (Self: TExpNode);
    function TokenCount{EF} (Self: TExpNode): System.Integer;
    function Calculate{E5} (Self: TExpNode): System.Double;
    property Tokens[Index: System.Integer]: TExpToken
      read TExpNode.GetToken{0xEB};
    property Parent:TExpNode read FParent{0x153};
    property Level:System.Integer read FLevel{0x156};
    property OnEvaluate:TOnEvaluate read FOnEvaluate{0x158}
      write FOnEvaluate{0x158};
  end;

  TFunction=class ({T#5}System.TObject) 
  protected
    FAsString: System.AnsiString;
    FName: System.AnsiString;
    FHead: System.AnsiString;
    FFunction: System.AnsiString;
    FOwner: System.TObject;
    FArgCount: System.Integer;
    FArgs: Classes.TStringList;
    FValues: ^array[$0..-$1] of System.Double;
  private
    procedure SetAsString{10B} (Self: TFunction; Value: System.AnsiString);
    procedure EvalArgs{102} (Self: TFunction; Sender: System.TObject;
      Eval: System.AnsiString; Args: array[$0..-$1] of System.Double;
      _Dv_: $0..-$1; ArgCount: System.Integer; var Value: System.Double);
  public
    constructor Create{F2} (Self: TFunction; _Dv_: false..true;
      AOwner: System.TObject);
    destructor Destroy{F6} (Self: TFunction; _Dv_: false..true); override{;
      virtual};
    function Call{F9} (Self: TFunction;
      Values: array[$0..-$1] of System.Double; _Dv_: $0..-$1):
      System.Double;
    property AsString:System.AnsiString read FAsString{0x16A}
      write TFunction.SetAsString{0x10B};
    property Name:System.AnsiString read FName{0x16B};
    property ArgCount:System.Integer read FArgCount{0x16F};
    property Args:Classes.TStringList read FArgs{0x170};
  end;

  TFatExpression=class ({T#4}Classes.TComponent) 
  protected
    FInfo: System.AnsiString;
    FText: System.AnsiString;
    FEvaluateOrder: TEvaluateOrder;
    FOnEvaluate: TOnEvaluate;
    FValue: System.Double;
    FFunctions: Classes.TStringList;
  private
    procedure Compile{11B} (Self: TFatExpression);
    function GetValue{131} (Self: TFatExpression): System.Double;
    procedure SetInfo{126} (Self: TFatExpression;
      Value: System.AnsiString);
    procedure Evaluate{129} (Self: TFatExpression; Eval: System.AnsiString;
      Args: array[$0..-$1] of System.Double; _Dv_: $0..-$1;
      var Value: System.Double);
    function FindFunction{120} (Self: TFatExpression;
      FuncName: System.AnsiString): TFunction;
    procedure SetFunctions{134} (Self: TFatExpression;
      Value: Classes.TStringList);
  public
    constructor Create{114} (Self: TFatExpression; _Dv_: false..true;
      AOwner: Classes.TComponent); override{; virtual};
    destructor Destroy{118} (Self: TFatExpression; _Dv_: false..true);
      override{; virtual};
    property Value:System.Double read TFatExpression.GetValue{0x131};
  published
    property Text:System.AnsiString read FText{0x17C} write FText{0x17C};
    property Info:System.AnsiString read FInfo{0x17B}
      write TFatExpression.SetInfo{0x126};
    property Functions:Classes.TStringList read FFunctions{0x180}
      write TFatExpression.SetFunctions{0x134};
    property EvaluateOrder:TEvaluateOrder read FEvaluateOrder{0x17D}
      write FEvaluateOrder{0x17D};
    property OnEvaluate:TOnEvaluate read FOnEvaluate{0x17E}
      write FOnEvaluate{0x17E};
  end;

procedure Register;

procedure Finalization;

procedure FatExpression;

implementation

var
  _DV_7: -$80000000..$7FFFFFFF;

const
  STR_OPERATION = 
    0: