
{
  TFatExpression by Gasper Kozak, gasper.kozak@email.si
  component is open-source and is free for any use
  version: 1.03, October 2001

  this is a component used for calculating text-presented expressions
  features
    operations: + - * / ^ !
    parenthesis: ( )
    variables: their values are requested through OnEvaluate event
    user-defined functions in format:
      function_name [ (argument_name [";" argument_name ... ]] "=" expression

  ! parental advisory : bugs included
  if you find any, fix it or let me know

  Update by Dmitry Yakubovich, 1.02 :),  August 2001
    fix ReadNextToken, for RangeCheck
    addon variable in form [Variable Name]
      Where the Name of a Variable can include any characters, except for closing square brackets "]"
      OnVariable for calculating
}

unit FatExpression103;

interface

uses Classes, Dialogs, Sysutils, Math;

type
  // empty token, numeric, (), +-*/^!, function or variable, ";" character, [] variable
  TTokenType = (ttNone, ttNumeric, ttParenthesis, ttOperation, ttString,
    ttParamDelimitor, ttVariable);
  TEvaluateOrder = (eoInternalFirst, eoEventFirst);
  TOnEvaluate = procedure(Sender: TObject; Eval: string; Args: array of Double;
    ArgCount: Integer; var Value: Double; var Done: Boolean) of object;
  TOnVariable = procedure(Sender: TObject; Variable: string; var Value: Double;
    var Done: Boolean) of object;

  // class used by TExpParser and TExpNode for breaking text into
  // tokens and building a syntax tree
  TExpToken = class
  private
    FText: string;
    FTokenType: TTokenType;
  public
    property Text: string read FText;
    property TokenType: TTokenType read FTokenType;
  end;

  // engine for breaking text into tokens
  TExpParser = class
  protected
    FExpression: string;
    FTokens: TList;
    FPos: Integer;
  private
    procedure Clear;
    function GetToken(Index: Integer): TExpToken;
    procedure SetExpression(const Value: string);
  public
    constructor Create;
    destructor Destroy; override;

    function ReadFirstToken: TExpToken;
    function ReadNextToken: TExpToken;

    function TokenCount: Integer;
    property Tokens[Index: Integer]: TExpToken read GetToken;
    property TokenList: TList read FTokens;
    property Expression: string read FExpression write SetExpression;
  end;

  // syntax-tree node. this engine uses a bit upgraded binary-tree
  TExpNode = class
  protected
    FOwner: TObject;
    FParent: TExpNode;
    FChildren: TList;
    FTokens: TList;
    FLevel: Integer;
    FToken: TExpToken;
    FOnEvaluate: TOnEvaluate;
    FOnVariable: TOnVariable;
  private
    function GetToken(Index: Integer): TExpToken;
    function GetChildren(Index: Integer): TExpNode;
    function FindLSOTI: Integer;
    // LSOTI = least significant operation token index
    function ParseFunction: Boolean;
    procedure RemoveSorroundingParenthesis;
    procedure SplitToChildren(TokenIndex: Integer);
    function Evaluate: Double;
    function Variable: Double;
    property Children[Index: Integer]: TExpNode read GetChildren;
    function ParseVariable: Boolean;
  public
    constructor Create(AOwner: TObject; AParent: TExpNode; Tokens: TList);
    destructor Destroy; override;
    procedure Build;

    function TokenCount: Integer;
    function Calculate: Double;
    property Tokens[Index: Integer]: TExpToken read GetToken;
    property Parent: TExpNode read FParent;
    property Level: Integer read FLevel;
    property OnEvaluate: TOnEvaluate read FOnEvaluate write FOnEvaluate;
    property OnVarible: TOnVariable read FOnVariable write FOnVariable;
  end;

  TFunction = class
  protected
    FAsString, FName, FHead, FFunction: string;
    FOwner: TObject;
    FArgCount: Integer;
    FArgs: TStringList;
    FValues: array of Double;
  private
    procedure SetAsString(const Value: string);
    procedure EvalArgs(Sender: TObject; Eval: string; Args: array of Double;
      ArgCount: Integer; var Value: Double);
  public
    constructor Create(AOwner: TObject);
    destructor Destroy; override;
    function Call(Values: array of Double): Double;
    property AsString: string read FAsString write SetAsString;
    property Name: string read FName;
    property ArgCount: Integer read FArgCount;
    property Args: TStringList read FArgs;
  end;

  // main component, actually only a wrapper for TExpParser, TExpNode and
  // user input via OnEvaluate event
  TFatExpression = class(TComponent)
  protected
    FInfo, FText: string;
    FEvaluateOrder: TEvaluateOrder;
    FOnEvaluate: TOnEvaluate;
    FOnVariable: TOnVariable;
    FValue: Double;
    FFunctions: TStringList;
  private
    procedure Compile;
    function GetValue: Double;
    procedure SetInfo(Value: string);
    procedure Evaluate(Eval: string; Args: array of Double; var Value: Double);
    function FindFunction(FuncName: string): TFunction;
    procedure SetFunctions(Value: TStringList);
    procedure Variable(Eval: string; var Value: Double);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Value: Double read GetValue;
  published
    property Text: string read FText write FText;
    property Info: string read FInfo write SetInfo;
    property Functions: TStringList read FFunctions write SetFunctions;
    property EvaluateOrder: TEvaluateOrder read FEvaluateOrder write
      FEvaluateOrder;
    property OnEvaluate: TOnEvaluate read FOnEvaluate write FOnEvaluate;
    property OnVariable: TOnVariable read FOnVariable write FOnVariable;
  end;

procedure Register;

implementation

const
  // supported operations
  STR_OPERATION = '+-*/^!';
  // function parameter delimitor
  STR_PARAMDELIMITOR = ';';
  // legal variable name characters
  STR_STRING: array[0..1] of string =
  ('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_',
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_$#@0123456789');

procedure Register;
begin
  RegisterComponents('Additional', [TFatExpression]);
end;

function OperParamateres(const Oper: string): Integer;
begin
  if Pos(Oper, '+-*/^') > 0 then
    Result := 2
  else if Oper = '!' then
    Result := 1
  else
    Result := 0;
end;

constructor TExpParser.Create;
begin
  inherited Create;
  FTokens := TList.Create;
end;

destructor TExpParser.Destroy;
begin
  Clear;
  FTokens.Free;
  inherited;
end;

procedure TExpParser.Clear;
begin
  while FTokens.Count > 0 do
  begin
    TExpToken(FTokens[0]).Free;
    FTokens.Delete(0);
  end;
end;

procedure TExpParser.SetExpression(const Value: string);
begin
  FExpression := Trim(Value);
end;

function TExpParser.GetToken(Index: Integer): TExpToken;
begin
  Result := TExpToken(FTokens[Index]);
end;

function TExpParser.ReadFirstToken: TExpToken;
begin
  Clear;
  FPos := 1;
  Result := ReadNextToken;
end;

function GetTokenType(S: string; First: Boolean): TTokenType;
var
  Value: Double;
  P, Error: Integer;
begin
  if (S = '(') or (S = ')') then
    Result := ttParenthesis
  else if S = STR_PARAMDELIMITOR then
    Result := ttParamDelimitor
  else if (S = '[') or (S = ']') then
    Result := ttVariable
  else if Pos(S, STR_OPERATION) > 0 then
    Result := ttOperation
  else
  begin
    Val(S, Value, Error);
    if Error = 0 then
      Result := ttNumeric
    else
    begin
      if First then
        P := Pos(S, STR_STRING[0])
      else
        P := Pos(S, STR_STRING[1]);

      if P > 0 then
        Result := ttString
      else
        Result := ttNone;
    end;
  end;
end;

function TExpParser.ReadNextToken: TExpToken;
var
  Part, Ch: string;
  FirstType, NextType: TTokenType;
  Sci: Boolean;
begin
  Result := nil;
  if FPos > Length(FExpression) then
    Exit;
  Sci := False;

  Part := '';
  repeat
    Ch := FExpression[FPos];
    Inc(FPos);
  until (Ch <> ' ') or (FPos > Length(FExpression));

  if FPos - 1 > Length(FExpression) then
    Exit;

  FirstType := GetTokenType(Ch, True);
  if FirstType = ttNone then
  begin
    raise
      Exception.CreateFmt('Parse error: illegal character "%s" at position %d.',
      [Ch, FPos - 1]);
    Exit;
  end;

  if FirstType in [ttParenthesis, ttOperation] then
  begin
    Result := TExpToken.Create;
    with Result do
    begin
      FText := Ch;
      FTokenType := FirstType;
    end;
    FTokens.Add(Result);
    Exit;
  end;

  if FirstType <> ttVariable then
    Part := Ch;

  repeat
    //Ch := FExpression[FPos];
    if FPos <= Length(FExpression) then
      Ch := FExpression[FPos]
    else
      Ch := #0;
    NextType := GetTokenType(Ch, False);

    NextType := GetTokenType(Ch, False);

    if (NextType = FirstType) and (FirstType <> ttVariable) or
       ((FirstType = ttVariable) and (NextType <> ttVariable)) or
       ((FirstType = ttString) and (NextType = ttNumeric)) or
       ((FirstType = ttNumeric) and (NextType = ttString) and (Ch = 'E') and (Sci = False)) or
       ((FirstType = ttNumeric) and (NextType = ttOperation) and (Ch = '-') and (Sci = True)) then
    begin
      Part := Part + Ch;
      if (FirstType = ttNumeric) and (NextType = ttString) and (Ch = 'E') then
        Sci := True;
    end else begin
      if (FirstType = ttVariable) and (NextType = ttVariable) then
        Inc(FPos);
      Result := TExpToken.Create;
      with Result do
      begin
        FText := Part;
        FTokenType := FirstType;
      end;
      FTokens.Add(Result);
      Exit;
    end;

    Inc(FPos);

  until FPos > Length(FExpression);

  Result := TExpToken.Create;
  with Result do
  begin
    FText := Part;
    FTokenType := FirstType;
  end;
  FTokens.Add(Result);
end;

function TExpParser.TokenCount: Integer;
begin
  Result := FTokens.Count;
end;

constructor TExpNode.Create(AOwner: TObject; AParent: TExpNode; Tokens: TList);
var
  I: Integer;
begin
  inherited Create;

  FOwner := AOwner;
  FParent := AParent;
  if FParent = nil then
    FLevel := 0
  else
    FLevel := FParent.Level + 1;

  FTokens := TList.Create;
  I := 0;
  while I < Tokens.Count do
  begin
    FTokens.Add(Tokens[I]);
    Inc(I);
  end;

  FChildren := TList.Create;

  if Tokens.Count = 1 then
    FToken := Tokens[0];
end;

destructor TExpNode.Destroy;
var
  Child: TExpNode;
begin
  if Assigned(FChildren) then
  begin
    while FChildren.Count > 0 do
    begin
      Child := Children[FChildren.Count - 1];
      FreeAndNil(Child);
      FChildren.Delete(FChildren.Count - 1);
    end;

    FreeAndNil(FChildren);
  end;

  FTokens.Free;
  inherited;
end;

procedure TExpNode.RemoveSorroundingParenthesis;
var
  First, Last, Lvl, I: Integer;
  Sorrounding: Boolean;
begin
  First := 0;
  Last := TokenCount - 1;
  while Last > First do
  begin
    if (Tokens[First].TokenType = ttParenthesis) and (Tokens[Last].TokenType =
      ttParenthesis) and
      (Tokens[First].Text = '(') and (Tokens[Last].Text = ')') then
    begin

      Lvl := 0;
      I := 0;
      Sorrounding := True;
      repeat
        if (Tokens[I].TokenType = ttParenthesis) and (Tokens[I].Text = '(') then
          Inc(Lvl)
        else if (Tokens[I].TokenType = ttParenthesis) and (Tokens[I].Text = ')')
          then
          Dec(Lvl);

        if (Lvl = 0) and (I < TokenCount - 1) then
        begin
          Sorrounding := False;
          Break;
        end;

        Inc(I);
      until I = TokenCount;

      if Sorrounding then
      begin
        FTokens.Delete(Last);
        FTokens.Delete(First);
      end
      else
        Exit;
    end
    else
      Exit;

    First := 0;
    Last := TokenCount - 1;
  end;
end;

procedure TExpNode.Build;
var
  LSOTI: Integer;
begin
  if TokenCount < 2 then
    Exit;
  RemoveSorroundingParenthesis;
  if TokenCount < 2 then
    Exit;

  LSOTI := FindLSOTI;
  if LSOTI < 0 then
  begin
    if ParseFunction then
      Exit
    else if ParseVariable then
      Exit;
    raise Exception.Create('Compile error: syntax fault.');
    Exit;
  end;
  SplitToChildren(LSOTI);
end;

function TExpNode.ParseFunction: Boolean;
var
  Func: Boolean;
  I, Delimitor, DelimitorLevel: Integer;
  FChild: TExpNode;
  FList: TList;
begin
  Result := False;
  if TokenCount < 4 then
    Exit;

  Func := (Tokens[0].TokenType = ttString) and
    (Tokens[1].TokenType = ttParenthesis) and (Tokens[TokenCount - 1].TokenType
    = ttParenthesis);

  if not Func then
    Exit;

  FToken := Tokens[0];
  with FTokens do
  begin
    Delete(TokenCount - 1);
    Delete(1);
  end;

  FList := TList.Create;
  try
    while TokenCount > 1 do
    begin
      Delimitor := -1;
      DelimitorLevel := 0;
      for I := 1 to TokenCount - 1 do
      begin
        if (Tokens[I].TokenType = ttParenthesis) and (Tokens[I].Text = '(') then
          Inc(DelimitorLevel)
        else if (Tokens[I].TokenType = ttParenthesis) and (Tokens[I].Text = ')')
          then
          Dec(DelimitorLevel)
        else if (Tokens[I].TokenType = ttParamDelimitor) and (DelimitorLevel = 0)
          then
        begin
          Delimitor := I - 1;
          FTokens.Delete(I);
          Break;
        end;

        if DelimitorLevel < 0 then
        begin
          raise Exception.Create('Function parse error.');
          Exit;
        end;
      end;

      if Delimitor = -1 then
        Delimitor := TokenCount - 1;
      for I := 1 to Delimitor do
      begin
        FList.Add(Tokens[1]);
        FTokens.Delete(1);
      end;
      FChild := TExpNode.Create(FOwner, Self, FList);
      FList.Clear;
      FChild.Build;
      FChildren.Add(FChild);
    end;
  finally
    FList.Free;
  end;
  Result := True;
end;

procedure TExpNode.SplitToChildren(TokenIndex: Integer);
var
  Left, Right: TList;
  I: Integer;
  FChild: TExpNode;
begin
  Left := TList.Create;
  Right := TList.Create;

  try
    if TokenIndex < TokenCount - 1 then
      for I := TokenCount - 1 downto TokenIndex + 1 do
      begin
        Right.Insert(0, FTokens[I]);
        FTokens.Delete(I);
      end;

    if Right.Count > 0 then
    begin
      FChild := TExpNode.Create(FOwner, Self, Right);
      FChildren.Insert(0, FChild);
      FChild.Build;
    end;

    if TokenIndex > 0 then
      for I := TokenIndex - 1 downto 0 do
      begin
        Left.Insert(0, FTokens[I]);
        FTokens.Delete(I);
      end;

    FChild := TExpNode.Create(FOwner, Self, Left);
    FChildren.Insert(0, FChild);
    FChild.Build;
  finally
    FToken := Tokens[0];
    Left.Free;
    Right.Free;
  end;
end;

function TExpNode.GetChildren(Index: Integer): TExpNode;
begin
  Result := TExpNode(FChildren[Index]);
end;

function TExpNode.ParseVariable: Boolean;
begin
  Result := False;
  if Tokens[0].TokenType = ttVariable then
    Result := True;
end;

function TExpNode.FindLSOTI: Integer;
var
  Lvl, I, LSOTI, NewOperPriority, OperPriority: Integer;
begin
  Lvl := 0; // Lvl = parenthesis level
  I := 0;
  LSOTI := -1;
  OperPriority := 9;

  repeat
    if Tokens[I].TokenType = ttParenthesis then
    begin
      if Tokens[I].Text = '(' then
        Inc(Lvl)
      else if Tokens[I].Text = ')' then
        Dec(Lvl);

      if Lvl < 0 then
      begin
        //raise Exception.CreateFmt('Parenthesis mismatch at level %d, token %d.', [Level, I]);
        raise Exception.Create('Compile error: parenthesis mismatch.');
        Exit;
      end;
    end;

    if (Tokens[I].TokenType = ttOperation) and (Lvl = 0) then
    begin
      NewOperPriority := Pos(Tokens[I].Text, STR_OPERATION);
      if NewOperPriority <= OperPriority then
      begin
        OperPriority := NewOperPriority;
        LSOTI := I;
      end;
    end;

    Inc(I);
  until I >= TokenCount;

  Result := LSOTI;
end;

function Exl(Value: Integer): Double;
begin
  if Value <= 1 then
    Result := Value
  else
    Result := Value * Exl(Value - 1);
end;

function TExpNode.Evaluate: Double;
var
  Args: array of Double;
  Count, I: Integer;
  Done: Boolean;
begin
  Result := 0;
  if FToken.TokenType = ttString then
  begin
    Count := FChildren.Count;
    SetLength(Args, Count);
    for I := 0 to Count - 1 do
      Args[I] := Children[I].Calculate;

    if Assigned(FOnEvaluate) then
      FOnEvaluate(Self, FToken.Text, Args, High(Args) + 1, Result, Done)
    else if FOwner is TFatExpression then
      TFatExpression(FOwner).Evaluate(FToken.Text, Args, Result)
    else if FOwner is TFunction then
      TFunction(FOwner).EvalArgs(Self, FToken.Text, Args, High(Args) + 1,
        Result);
  end;
end;

function TExpNode.Variable: Double;
var
  Done: Boolean;
begin
  Result := 0;
  if FToken.TokenType = ttVariable then
  begin

    if Assigned(FOnVariable) then
      FOnVariable(Self, FToken.Text, Result, Done);
    if FOwner is TFatExpression then
      TFatExpression(FOwner).Variable(FToken.Text, Result);
  end;
end;

function TExpNode.Calculate: Double;
var
  Error: Integer;
  DivX, DivY: Double;
begin
  Result := 0;
  if (FToken = nil) or (TokenCount = 0) then
    Exit;

  if TokenCount = 1 then
  begin
    if FToken.TokenType = ttNumeric then
    begin
      Val(FToken.Text, Result, Error);
    end
    else if FToken.TokenType = ttString then
    begin
      Result := Evaluate;
    end
    else if FToken.TokenType = ttVariable then
    begin
      Result := Variable;
    end
    else if FToken.TokenType = ttOperation then
    begin
      if FChildren.Count <> OperParamateres(FToken.Text) then
      begin
        raise Exception.Create('Calculate error: syntax tree fault.');
        Exit;
      end;
      if FToken.Text = '+' then
        Result := Children[0].Calculate + Children[1].Calculate
      else if FToken.Text = '-' then
        Result := Children[0].Calculate - Children[1].Calculate
      else if FToken.Text = '*' then
        Result := Children[0].Calculate * Children[1].Calculate
      else if FToken.Text = '/' then
      begin
        DivX := Children[0].Calculate;
        DivY := Children[1].Calculate;
        if DivY <> 0 then
          Result := DivX / DivY
        else
        begin
          raise
            Exception.CreateFmt('Calculate error: "%f / %f" divison by zero.',
            [DivX, DivY]);
          Exit;
        end;
      end
      else if FToken.Text = '^' then
        Result := Power(Children[0].Calculate, Children[1].Calculate)
      else if FToken.Text = '!' then
        Result := Exl(Round(Children[0].Calculate));
    end;
  end;
end;

function TExpNode.GetToken(Index: Integer): TExpToken;
begin
  Result := TExpToken(FTokens[Index]);
end;

function TExpNode.TokenCount: Integer;
begin
  Result := FTokens.Count;
end;

constructor TFunction.Create(AOwner: TObject);
begin
  inherited Create;
  FOwner := AOwner;
  FAsString := '';
  FName := '';
  FArgCount := 0;
  FArgs := TStringList.Create;
end;

destructor TFunction.Destroy;
begin
  FArgs.Free;
  inherited;
end;

function TFunction.Call(Values: array of Double): Double;
var
  Token: TExpToken;
  Tree: TExpNode;
  Parser: TExpParser;
  I: Integer;
begin
  SetLength(FValues, High(Values) + 1);
  for I := 0 to High(Values) do
    FValues[I] := Values[I];

  Parser := TExpParser.Create;
  try
    Parser.Expression := FFunction;
    Token := Parser.ReadFirstToken;
    while Token <> nil do
      Token := Parser.ReadNextToken;

    Tree := TExpNode.Create(Self, nil, Parser.TokenList);
    try
      with Tree do
      begin
        Build;
        Result := Calculate;
      end;
    finally
      Tree.Free;
    end;
  finally
    Parser.Free;
  end;
end;

procedure TFunction.EvalArgs(Sender: TObject; Eval: string; Args: array of
  Double; ArgCount: Integer; var Value: Double);
var
  I: Integer;
begin
  for I := 0 to FArgs.Count - 1 do
    if UpperCase(FArgs[I]) = UpperCase(Eval) then
    begin
      Value := FValues[I];
      Exit;
    end;

  if FOwner is TFatExpression then
    TFatExpression(FOwner).Evaluate(Eval, Args, Value);
end;

procedure TFunction.SetAsString(const Value: string);
var
  Head: string;
  HeadPos: Integer;
  Parser: TExpParser;
  Token: TExpToken;
  ExpectParenthesis, ExpectDelimitor: Boolean;
begin
  FArgs.Clear;
  FArgCount := 0;
  FAsString := Value;
  FHead := '';
  FFunction := '';
  FName := '';

  HeadPos := Pos('=', FAsString);
  if HeadPos = 0 then
    Exit;
  Head := Copy(FAsString, 1, HeadPos - 1);
  FFunction := FAsString;
  Delete(FFunction, 1, HeadPos);
  Parser := TExpParser.Create;
  try
    Parser.Expression := Head;
    Token := Parser.ReadFirstToken;
    if (Token = nil) or (Token.TokenType <> ttString) then
    begin
      raise Exception.CreateFmt('Function "%s" is not valid.', [FAsString]);
      Exit;
    end;
    FName := Token.Text;

    Token := Parser.ReadNextToken;
    if Token = nil then
      Exit;
    if Token.TokenType = ttParenthesis then
    begin
      if Token.Text = '(' then
        ExpectParenthesis := True
      else
      begin
        raise Exception.CreateFmt('Function header "%s" is not valid.', [Head]);
        Exit;
      end;
    end
    else
      ExpectParenthesis := False;

    ExpectDelimitor := False;
    while Token <> nil do
    begin
      Token := Parser.ReadNextToken;
      if Token <> nil then
      begin
        if Token.TokenType = ttParenthesis then
        begin
          if ExpectParenthesis and (Token.Text = ')') then
            Exit
          else
          begin
            raise Exception.CreateFmt('Function header "%s" is not valid.',
              [Head]);
            Exit;
          end;
        end;

        if ExpectDelimitor then
        begin
          if (Token.TokenType <> ttParamDelimitor) and (Token.TokenType <>
            ttParenthesis) then
          begin
            raise
              Exception.Create('Function parse error: delimitor ";" expected between arguments.');
            Exit;
          end;
          ExpectDelimitor := False;
          Continue;
        end;

        if Token.TokenType = ttString then
        begin
          FArgs.Add(Token.Text);
          FArgCount := FArgs.Count;
          ExpectDelimitor := True;
        end;
      end;
    end;
    if ExpectParenthesis then
      raise Exception.CreateFmt('Function header "%s" is not valid.', [Head]);
  finally
    Parser.Free;
  end;
end;

constructor TFatExpression.Create;
begin
  inherited;
  FText := '';
  FInfo := 'TFatExpression v1.0 by gasper.kozak@email.si';
  FFunctions := TStringList.Create;
end;

destructor TFatExpression.Destroy;
begin
  FFunctions.Free;
  inherited;
end;

procedure TFatExpression.Compile;
var
  Token: TExpToken;
  Tree: TExpNode;
  Parser: TExpParser;
begin
  Parser := TExpParser.Create;
  try
    Parser.Expression := FText;
    Token := Parser.ReadFirstToken;
    while Token <> nil do
      Token := Parser.ReadNextToken;

    Tree := TExpNode.Create(Self, nil, Parser.TokenList);
    try
      with Tree do
      begin
        Build;
        FValue := Calculate;
      end;
    finally
      Tree.Free;
    end;
  finally
    Parser.Free;
  end;
end;

function TFatExpression.FindFunction(FuncName: string): TFunction;
var
  F: TFunction;
  I: Integer;
begin
  Result := nil;
  for I := 0 to FFunctions.Count - 1 do
    if Trim(FFunctions[I]) <> '' then
    begin
      F := TFunction.Create(Self);
      F.AsString := FFunctions[I];
      if UpperCase(F.Name) = UpperCase(FuncName) then
      begin
        Result := F;
        Exit;
      end;
      F.Free;
    end;
end;

procedure TFatExpression.SetInfo(Value: string);
begin
  //
end;

procedure TFatExpression.Evaluate(Eval: string; Args: array of Double; var
  Value: Double);
var
  Func: TFunction;
  Done: Boolean;
begin

  Done := False;

  if (EvaluateOrder = eoEventFirst) and Assigned(FOnEvaluate) then
  begin
    FOnEvaluate(Self, Eval, Args, High(Args) + 1, Value, Done);
    if Done then
      Exit;
  end
  else
    Value := 0;

  Func := FindFunction(Eval);
  if Func <> nil then
  begin
    Value := Func.Call(Args);
    Func.Free;
    Exit;
  end;

  if (EvaluateOrder = eoInternalFirst) and Assigned(FOnEvaluate) then
    FOnEvaluate(Self, Eval, Args, High(Args) + 1, Value, Done)
  else
    Value := 0;

end;

procedure TFatExpression.Variable(Eval: string; var Value: Double);
var
  Done: Boolean;
begin
  Done := False;
  if Assigned(FOnVariable) then
  begin
    FOnVariable(Self, Eval, Value, Done);
    if Done then
      Exit;
  end
  else
    Value := 0;
end;

function TFatExpression.GetValue: Double;
begin
  Compile;
  Result := FValue;
end;

procedure TFatExpression.SetFunctions(Value: TStringList);
begin
  FFunctions.Assign(Value);
end;

end.

