source upload

contrib/ParseExpression/FormExpr.pas

@@ -0,0 +1,235 @@
+unit FormExpr;
+{--------------------------------------------------------------
+| TFormulaParser
+|  Multi formula support
+|  Extension by Xavier Mor-Mur
+|  xmormur@telepolis.com
+|  xmormur@teleline.es
+|
+|---------------------------------------------------------------}
+interface
+uses Dialogs, OObjects, SysUtils, Classes, ParseExpr, ParseClass;
+type
+
+  TFormulaParser = class(TExpressionParser)
+  private
+    FormulaNames: TStringList;
+    tslTmp: TStringList;
+    bTrace: Boolean;
+    ExprResult: double;
+  protected
+    procedure FillExpressList; override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Formula(FName, FExpr: string): Integer;
+    function Eval(FIndex: Integer): double; overload;
+    function Eval(FName: string): double; overload;
+    function Index(FName: string): Integer;
+    function Name(FIndex: Integer): string;
+    function Text(FName: string): string;
+    property Trace: Boolean read bTrace write bTrace;
+  end;
+implementation
+uses Math;
+
+var
+  sExpr: string; // needed for display(...) function
+
+{ TFormulaParser }
+
+constructor TFormulaParser.Create;
+begin
+  inherited;
+  FormulaNames := TStringList.Create;
+  tslTmp := TStringList.Create;
+  DefineVariable('#', @ExprResult);
+end;
+
+destructor TFormulaParser.Destroy;
+begin
+  inherited;
+  FormulaNames.Free;
+  tslTmp.Free;
+end;
+
+//---> Added start
+// set formula string
+
+function TFormulaParser.Formula(FName, FExpr: string): Integer;
+var
+  i, j: Integer;
+  expr: TStringList;
+begin
+  tslTmp.Clear;
+  tslTmp.SetText(PChar(FExpr));
+  expr := TStringList.Create;
+  Result := -1;
+  i := FormulaNames.IndexOf(FName);
+  if i >= 0 then
+    FormulaNames.Delete(i);
+  if tslTmp.Count > 0 then
+  begin
+    for i := 0 to tslTmp.Count - 1 do
+    begin
+      if tslTmp.Strings[i] <> '' then
+      begin
+        j := AddExpression(tslTmp.Strings[i]);
+        if j < 0 then
+          break;
+        if (copy(Expression[j], 1, 5) = 'goto(') or
+          (copy(Expression[j], 1, 7) = 'ifgoto(') or
+          (copy(Expression[j], 1, 8) = 'display(') or
+          (copy(Expression[j], 1, 4) = 'stop') then
+          expr.Add(IntToStr(-(j + 1)))
+        else
+          expr.Add(IntToStr(j + 1));
+      end;
+    end;
+    if expr.Count > 0 then
+      Result := FormulaNames.AddObject(FName, TObject(expr));
+  end;
+end;
+
+// evaluate formula by name
+
+function TFormulaParser.Eval(FName: string): double;
+var
+  i: Integer;
+begin
+  Result := 0;
+  i := FormulaNames.IndexOf(FName);
+  if i >= 0 then
+    Result := Eval(i);
+end;
+
+// evaluate formula by index
+
+function TFormulaParser.Eval(FIndex: Integer): double;
+var
+  i, j, k: Integer;
+  expr: TStringList;
+begin
+  ExprResult := 0;
+  if (FIndex >= 0) and (FIndex < FormulaNames.Count) then
+  begin
+    expr := TStringList(FormulaNames.Objects[FIndex]);
+    i := 0;
+    while i < expr.Count do
+    begin
+      Val(expr.Strings[i], j, k);
+      sExpr := '(' + IntToStr(i + 1) + ') ' + Expression[abs(j) - 1] +
+        char($0D0A) + char($0D0A);
+      if j < 0 then
+      begin
+        k := trunc(AsFloat[abs(j) - 1]);
+        if k > 0 then
+          i := k - 1 // goto(...), ifgoto(...), stop
+        else
+        begin
+          i := i + 1; // display(...)
+        end;
+      end
+      else
+      begin
+        ExprResult := AsFloat[abs(j) - 1];
+        i := i + 1;
+      end;
+      if Trace then
+        ShowMessage(sExpr + FloatToStr(ExprResult));
+    end;
+  end;
+  Result := ExprResult;
+end;
+
+// get formula index from its name
+
+function TFormulaParser.Index(FName: string): Integer;
+begin
+  Result := FormulaNames.IndexOf(FName);
+end;
+
+// get formula name from its index
+
+function TFormulaParser.Name(FIndex: Integer): string;
+begin
+  if (FIndex >= 0) and (FIndex < FormulaNames.Count) then
+    Result := FormulaNames.Strings[FIndex]
+  else
+    Result := '';
+end;
+
+// get formula string
+
+function TFormulaParser.Text(FName: string): string;
+var
+  i, j, k: Integer;
+  expr: TStringList;
+begin
+  tslTmp.Clear;
+  i := FormulaNames.IndexOf(FName);
+  if i >= 0 then
+  begin
+    expr := TStringList(FormulaNames.Objects[i]);
+    for i := 0 to expr.Count - 1 do
+    begin
+      Val(expr.Strings[i], j, k);
+      tslTmp.Add(Expression[abs(j)-1]);
+    end;
+  end;
+  Result := tslTmp.Text;
+end;
+
+procedure _stop(Param: PExpressionRec);
+begin
+  with Param^ do
+  begin
+    Res := 999999;
+  end;
+end;
+
+procedure _goto(Param: PExpressionRec);
+begin
+  with Param^ do
+  begin
+    Res := trunc(Args[0]^);
+  end;
+end;
+
+procedure _ifgoto(Param: PExpressionRec);
+begin
+  with Param^ do
+  begin
+    if Args[0]^ < 0 then
+      Res := Args[1]^
+    else if Args[0]^ = 0 then
+      Res := Args[2]^
+    else if Args[0]^ > 0 then
+      Res := Args[3]^;
+  end;
+end;
+
+procedure _display(Param: PExpressionRec);
+begin
+  with Param^ do
+  begin
+    sExpr := sExpr + char($0D0A) + char($0D0A) + FloatToStr(Args[0]^);
+    ShowMessage(sExpr);
+    Res := 0;
+  end;
+end;
+
+procedure TFormulaParser.FillExpressList;
+begin
+  inherited;
+  with WordsList do
+  begin
+    Add(TFunction.Create('stop', 'stop execution formula', _stop, 0));
+    Add(TFunction.Create('goto', 'goto line number', _goto, 1));
+    Add(TFunction.Create('ifgoto', 'conditional goto', _ifgoto, 4));
+    Add(TFunction.Create('display', 'display result', _display, 1));
+  end;
+end;
+
+end.
+

contrib/ParseExpression/ParseClass.pas

@@ -0,0 +1,719 @@
+unit ParseClass;
+
+interface
+
+uses OObjects, SysUtils;
+
+const
+  MaxArg = 1000;
+
+const
+  Nan: Double = 0 / 0;
+function isNan(const d: Double): boolean;
+
+type
+  TVarType = (vtDouble, vtBoolean, vtString, vtLeftBracket,
+    vtRightBracket, vtComma);
+  PDouble = ^Double;
+  EParserException = class(Exception);
+  PExpressionRec = ^TExpressionRec;
+
+  TExprWord = class;
+
+  TArgsArray = record
+    Res: Double;
+    Args: array [0 .. MaxArg - 1] of PDouble;
+    ExprWord: TExprWord; // can be used to notify the object to update
+  end;
+
+  TDoubleFunc = procedure(Expr: PExpressionRec);
+
+  TStringFunc = function(s1, s2: string): Double;
+
+  TExpressionRec = record
+    // used both as linked tree and linked list for maximum evaluation efficiency
+    Oper: TDoubleFunc;
+    Next: PExpressionRec;
+    Res: Double;
+    ExprWord: TExprWord;
+    case Byte of
+      0:
+        (Args: array [0 .. MaxArg - 1] of PDouble;
+          // can be used to notify the object to update
+        );
+      1:
+        (ArgList: array [0 .. MaxArg - 1] of PExpressionRec);
+  end;
+
+  TExprCollection = class(TNoOwnerCollection)
+  public
+    function NextOper(IStart: Integer): Integer;
+    procedure Check;
+    procedure EraseExtraBrackets;
+  end;
+
+  TExprWord = class
+  private
+    FName: string;
+    FDoubleFunc: TDoubleFunc;
+  protected
+    function GetIsOper: boolean; virtual;
+    function GetAsString: string; virtual;
+    function GetIsVariable: boolean;
+    function GetCanVary: boolean; virtual;
+    function GetVarType: TVarType; virtual;
+    function GetNFunctionArg: Integer; virtual;
+    function GetDescription: string; virtual;
+  public
+    constructor Create(AName: string; ADoubleFunc: TDoubleFunc);
+    function AsPointer: PDouble; virtual;
+    property AsString: string read GetAsString;
+    property DoubleFunc: TDoubleFunc read FDoubleFunc;
+    property IsOper: boolean read GetIsOper;
+    property CanVary: boolean read GetCanVary;
+    property isVariable: boolean read GetIsVariable;
+    property VarType: TVarType read GetVarType;
+    property NFunctionArg: Integer read GetNFunctionArg;
+    property Name: string read FName;
+    property Description: string read GetDescription;
+  end;
+
+  TExpressList = class(TSortedCollection)
+  public
+    function KeyOf(Item: Pointer): Pointer; override;
+    function Compare(Key1, Key2: Pointer): Integer; override;
+  end;
+
+  TDoubleConstant = class(TExprWord)
+  private
+    FValue: Double;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: string);
+    constructor CreateAsDouble(AName: string; AValue: Double);
+    // not overloaded to support older Delphi versions
+    property Value: Double read FValue write FValue;
+  end;
+
+  TConstant = class(TDoubleConstant)
+  private
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+  public
+    constructor CreateAsDouble(AName, Descr: string; AValue: Double);
+  end;
+
+  TBooleanConstant = class(TDoubleConstant)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TGeneratedVariable = class(TDoubleConstant)
+  private
+    FAsString: string;
+    FVarType: TVarType;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string);
+    property VarType read GetVarType write FVarType;
+    property AsString: string read GetAsString write FAsString;
+  end;
+
+  TDoubleVariable = class(TExprWord)
+  private
+    FValue: PDouble;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: PDouble);
+  end;
+
+  TStringConstant = class(TExprWord)
+  private
+    FValue: string;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+  public
+    constructor Create(AValue: string);
+  end;
+
+  TLeftBracket = class(TExprWord)
+    function GetVarType: TVarType; override;
+  end;
+
+  TRightBracket = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TComma = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  PString = ^string;
+
+  TStringVariable = class(TExprWord)
+  private
+    FValue: PString;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string; AValue: PString);
+  end;
+
+  TFunction = class(TExprWord)
+  private
+    FIsOper: boolean;
+    FOperPrec: Integer;
+    FNFunctionArg: Integer;
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+    function GetIsOper: boolean; override;
+    function GetNFunctionArg: Integer; override;
+  public
+    constructor Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer);
+    constructor CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+    property OperPrec: Integer read FOperPrec;
+  end;
+
+  TVaryingFunction = class(TFunction)
+    // Functions that can vary for ex. random generators
+    // should be TVaryingFunction to be sure that they are
+    // always evaluated
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TBooleanFunction = class(TFunction)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TOper = (op_eq, op_gt, op_lt, op_ge, op_le, op_in);
+
+const
+  ListChar = ','; { the delimiter used with the 'in' operator: e.g.,
+    ('a' in 'a,b') =True
+    ('c' in 'a,b') =False }
+
+type
+  TSimpleStringFunction = class(TFunction)
+  private
+    FStringFunc: TStringFunc;
+    FLeftArg: TExprWord;
+    FRightArg: TExprWord;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName, Descr: string; AStringFunc: TStringFunc;
+      ALeftArg, ARightArg: TExprWord);
+    function Evaluate: Double;
+    property StringFunc: TStringFunc read FStringFunc;
+  end;
+
+  TVaryingStringFunction = class(TSimpleStringFunction)
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TLogicalStringOper = class(TSimpleStringFunction)
+  protected
+    function GetVarType: TVarType; override;
+  public
+    constructor Create(AOper: string; ALeftArg: TExprWord;
+      ARightArg: TExprWord);
+  end;
+
+procedure _Variable(Param: PExpressionRec);
+
+// procedure _StringFunc(Param: PExpressionRec);
+
+implementation
+
+// function _StrIn(sLookfor, sData: string): Double;
+
+// function _StrInt(a, b: string): Double;
+
+function isNan(const d: Double): boolean;
+begin
+  Result := comp(d) = comp(Nan);
+  // slower alternative: CompareMem(@d, @Nan, SizeOf(Double))
+end;
+
+procedure _Variable(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := Args[0]^;
+end;
+
+procedure _StringFunc(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := TSimpleStringFunction(ExprWord).Evaluate;
+end;
+
+function _StrInt(a, b: string): Double;
+begin
+  Result := StrToInt(a);
+end;
+
+function _StrEq(s1, s2: string): Double;
+begin
+  Result := Byte(s1 = s2);
+end;
+
+function _StrGt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 > s2);
+end;
+
+function _Strlt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 < s2);
+end;
+
+function _StrGe(s1, s2: string): Double;
+begin
+  Result := Byte(s1 >= s2);
+end;
+
+function _Strle(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <= s2);
+end;
+
+function _Strne(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <> s2);
+end;
+
+function _StrIn(sLookfor, sData: string): Double;
+var
+  loop: Integer;
+  subString: string;
+begin
+  Result := 0;
+  loop := pos(ListChar, sData);
+  while loop > 0 do
+  begin
+    subString := Copy(sData, 1, loop - 1);
+    sData := Copy(sData, loop + 1, Length(sData));
+    if subString = sLookfor then
+    begin
+      Result := 1;
+      break;
+    end;
+    loop := pos(ListChar, sData);
+  end;
+  if sLookfor = sData then
+    Result := 1;
+end;
+
+{ TExpressionWord }
+
+function TExprWord.AsPointer: PDouble;
+begin
+  Result := nil;
+end;
+
+constructor TExprWord.Create(AName: string; ADoubleFunc: TDoubleFunc);
+begin
+  FName := LowerCase(AName);
+  FDoubleFunc := ADoubleFunc;
+end;
+
+function TExprWord.GetAsString: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetCanVary: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetDescription: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetIsOper: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetIsVariable: boolean;
+begin
+  Result := @FDoubleFunc = @_Variable
+end;
+
+function TExprWord.GetNFunctionArg: Integer;
+begin
+  Result := 0;
+end;
+
+function TExprWord.GetVarType: TVarType;
+begin
+  Result := vtDouble;
+end;
+
+{ TDoubleConstant }
+
+function TDoubleConstant.AsPointer: PDouble;
+begin
+  Result := @FValue;
+end;
+
+constructor TDoubleConstant.Create(AName, AValue: string);
+begin
+  inherited Create(AName, _Variable);
+  if AValue <> '' then
+    FValue := StrToFloat(AValue)
+  else
+    FValue := Nan;
+end;
+
+constructor TDoubleConstant.CreateAsDouble(AName: string; AValue: Double);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+{ TStringConstant }
+
+function TStringConstant.GetAsString: string;
+begin
+  Result := FValue;
+end;
+
+constructor TStringConstant.Create(AValue: string);
+begin
+  inherited Create(AValue, _Variable);
+  if (AValue[1] = '''') and (AValue[Length(AValue)] = '''') then
+    FValue := Copy(AValue, 2, Length(AValue) - 2)
+  else
+    FValue := AValue;
+end;
+
+function TStringConstant.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+{ TDoubleVariable }
+
+function TDoubleVariable.AsPointer: PDouble;
+begin
+  Result := FValue;
+end;
+
+constructor TDoubleVariable.Create(AName: string; AValue: PDouble);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TDoubleVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TFunction }
+
+constructor TFunction.Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer);
+begin
+  FDescription := Descr;
+  CreateOper(AName, ADoubleFunc, ANFunctionArg, False, 0);
+  // to increase compatibility don't use default parameters
+end;
+
+constructor TFunction.CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+begin
+  inherited Create(AName, ADoubleFunc);
+  FNFunctionArg := ANFunctionArg;
+  if FNFunctionArg > MaxArg then
+    raise EParserException.Create('Too many arguments');
+  FIsOper := AIsOper;
+  FOperPrec := AOperPrec;
+end;
+
+function TFunction.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+function TFunction.GetIsOper: boolean;
+begin
+  Result := FIsOper;
+end;
+
+function TFunction.GetNFunctionArg: Integer;
+begin
+  Result := FNFunctionArg;
+end;
+
+{ TLeftBracket }
+
+function TLeftBracket.GetVarType: TVarType;
+begin
+  Result := vtLeftBracket;
+end;
+
+{ TExpressList }
+
+function TExpressList.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Result := StrIComp(Pchar(Key1), Pchar(Key2));
+end;
+
+function TExpressList.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := Pchar(TExprWord(Item).Name);
+end;
+
+{ TRightBracket }
+
+function TRightBracket.GetVarType: TVarType;
+begin
+  Result := vtRightBracket;
+end;
+
+{ TComma }
+
+function TComma.GetVarType: TVarType;
+begin
+  Result := vtComma;
+end;
+
+{ TExprCollection }
+
+procedure TExprCollection.Check;
+var
+  brCount, I: Integer;
+begin
+  brCount := 0;
+  for I := 0 to Count - 1 do
+  begin
+    case TExprWord(Items[I]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+  end;
+  if brCount <> 0 then
+    raise EParserException.Create('Unequal brackets');
+end;
+
+procedure TExprCollection.EraseExtraBrackets;
+var
+  I: Integer;
+  brCount: Integer;
+begin
+  if (TExprWord(Items[0]).VarType = vtLeftBracket) then
+  begin
+    brCount := 1;
+    I := 1;
+    while (I < Count) and (brCount > 0) do
+    begin
+      case TExprWord(Items[I]).VarType of
+        vtLeftBracket:
+          Inc(brCount);
+        vtRightBracket:
+          Dec(brCount);
+      end;
+      Inc(I);
+    end;
+    if (brCount = 0) and (I = Count) and
+      (TExprWord(Items[I - 1]).VarType = vtRightBracket) then
+    begin
+      for I := 0 to Count - 3 do
+        Items[I] := Items[I + 1];
+      Count := Count - 2;
+      EraseExtraBrackets; // Check if there are still too many brackets
+    end;
+  end;
+end;
+
+function TExprCollection.NextOper(IStart: Integer): Integer;
+var
+  brCount: Integer;
+begin
+  brCount := 0;
+  Result := IStart;
+  while (Result < Count) and
+    ((brCount > 0) or (TExprWord(Items[Result]).NFunctionArg <= 0)) do
+  begin
+    case TExprWord(Items[Result]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+    Inc(Result);
+  end;
+end;
+
+{ TStringVariable }
+
+function TStringVariable.GetAsString: string;
+begin
+  if (FValue^[1] = '''') and (FValue^[Length(FValue^)] = '''') then
+    Result := Copy(FValue^, 2, Length(FValue^) - 2)
+  else
+    Result := FValue^
+end;
+
+constructor TStringVariable.Create(AName: string; AValue: PString);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TStringVariable.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+function TStringVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TLogicalStringOper }
+
+constructor TLogicalStringOper.Create(AOper: string;
+  ALeftArg, ARightArg: TExprWord);
+begin
+  if AOper = '=' then
+    FStringFunc := @_StrEq
+  else if AOper = '>' then
+    FStringFunc := @_StrGt
+  else if AOper = '<' then
+    FStringFunc := @_Strlt
+  else if AOper = '>=' then
+    FStringFunc := @_StrGe
+  else if AOper = '<=' then
+    FStringFunc := @_Strle
+  else if AOper = '<>' then
+    FStringFunc := @_Strne
+  else if AOper = 'in' then
+    FStringFunc := @_StrIn
+  else
+    raise EParserException.Create(AOper + ' is not a valid string operand');
+  inherited Create(AOper, '', StringFunc, ALeftArg, ARightArg);
+end;
+
+function TLogicalStringOper.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TBooleanFunction }
+
+function TBooleanFunction.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TGeneratedVariable }
+
+constructor TGeneratedVariable.Create(AName: string);
+begin
+  inherited Create(AName, '');
+  FAsString := '';
+  FVarType := vtDouble;
+end;
+
+function TGeneratedVariable.GetAsString: string;
+begin
+  Result := FAsString;
+end;
+
+function TGeneratedVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+function TGeneratedVariable.GetVarType: TVarType;
+begin
+  Result := FVarType;
+end;
+
+{ TVaryingFunction }
+
+function TVaryingFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TBooleanConstant }
+
+function TBooleanConstant.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TConstant }
+
+constructor TConstant.CreateAsDouble(AName, Descr: string; AValue: Double);
+begin
+  FDescription := Descr;
+  inherited CreateAsDouble(AName, AValue);
+end;
+
+function TConstant.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+{ TSimpleStringFunction }
+
+constructor TSimpleStringFunction.Create(AName, Descr: string;
+  AStringFunc: TStringFunc; ALeftArg, ARightArg: TExprWord);
+begin
+  FStringFunc := @AStringFunc;
+  FLeftArg := ALeftArg;
+  FRightArg := ARightArg;
+  inherited Create(AName, Descr, _StringFunc, 0)
+end;
+
+function TSimpleStringFunction.Evaluate: Double;
+var
+  s1, s2: string;
+begin
+  s1 := FLeftArg.AsString;
+  if FRightArg <> nil then
+    s2 := FRightArg.AsString
+  else
+    s2 := '';
+  Result := StringFunc(s1, s2);
+end;
+
+function TSimpleStringFunction.GetCanVary: boolean;
+begin
+  Result := ((FLeftArg <> nil) and FLeftArg.CanVary) or
+    ((FRightArg <> nil) and FRightArg.CanVary);
+end;
+{ TVaryingStringFunction }
+
+function TVaryingStringFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+end.

contrib/ParseExpression/__history/ParseClass.pas.~1~

@@ -0,0 +1,719 @@
+unit ParseClass;
+
+interface
+
+uses OObjects, SysUtils;
+
+const
+  MaxArg = 6;
+
+const
+  Nan: Double = 0 / 0;
+function isNan(const d: Double): boolean;
+
+type
+  TVarType = (vtDouble, vtBoolean, vtString, vtLeftBracket,
+    vtRightBracket, vtComma);
+  PDouble = ^Double;
+  EParserException = class(Exception);
+  PExpressionRec = ^TExpressionRec;
+
+  TExprWord = class;
+
+  TArgsArray = record
+    Res: Double;
+    Args: array [0 .. MaxArg - 1] of PDouble;
+    ExprWord: TExprWord; // can be used to notify the object to update
+  end;
+
+  TDoubleFunc = procedure(Expr: PExpressionRec);
+
+  TStringFunc = function(s1, s2: string): Double;
+
+  TExpressionRec = record
+    // used both as linked tree and linked list for maximum evaluation efficiency
+    Oper: TDoubleFunc;
+    Next: PExpressionRec;
+    Res: Double;
+    ExprWord: TExprWord;
+    case Byte of
+      0:
+        (Args: array [0 .. MaxArg - 1] of PDouble;
+          // can be used to notify the object to update
+        );
+      1:
+        (ArgList: array [0 .. MaxArg - 1] of PExpressionRec);
+  end;
+
+  TExprCollection = class(TNoOwnerCollection)
+  public
+    function NextOper(IStart: Integer): Integer;
+    procedure Check;
+    procedure EraseExtraBrackets;
+  end;
+
+  TExprWord = class
+  private
+    FName: string;
+    FDoubleFunc: TDoubleFunc;
+  protected
+    function GetIsOper: boolean; virtual;
+    function GetAsString: string; virtual;
+    function GetIsVariable: boolean;
+    function GetCanVary: boolean; virtual;
+    function GetVarType: TVarType; virtual;
+    function GetNFunctionArg: Integer; virtual;
+    function GetDescription: string; virtual;
+  public
+    constructor Create(AName: string; ADoubleFunc: TDoubleFunc);
+    function AsPointer: PDouble; virtual;
+    property AsString: string read GetAsString;
+    property DoubleFunc: TDoubleFunc read FDoubleFunc;
+    property IsOper: boolean read GetIsOper;
+    property CanVary: boolean read GetCanVary;
+    property isVariable: boolean read GetIsVariable;
+    property VarType: TVarType read GetVarType;
+    property NFunctionArg: Integer read GetNFunctionArg;
+    property Name: string read FName;
+    property Description: string read GetDescription;
+  end;
+
+  TExpressList = class(TSortedCollection)
+  public
+    function KeyOf(Item: Pointer): Pointer; override;
+    function Compare(Key1, Key2: Pointer): Integer; override;
+  end;
+
+  TDoubleConstant = class(TExprWord)
+  private
+    FValue: Double;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: string);
+    constructor CreateAsDouble(AName: string; AValue: Double);
+    // not overloaded to support older Delphi versions
+    property Value: Double read FValue write FValue;
+  end;
+
+  TConstant = class(TDoubleConstant)
+  private
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+  public
+    constructor CreateAsDouble(AName, Descr: string; AValue: Double);
+  end;
+
+  TBooleanConstant = class(TDoubleConstant)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TGeneratedVariable = class(TDoubleConstant)
+  private
+    FAsString: string;
+    FVarType: TVarType;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string);
+    property VarType read GetVarType write FVarType;
+    property AsString: string read GetAsString write FAsString;
+  end;
+
+  TDoubleVariable = class(TExprWord)
+  private
+    FValue: PDouble;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: PDouble);
+  end;
+
+  TStringConstant = class(TExprWord)
+  private
+    FValue: string;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+  public
+    constructor Create(AValue: string);
+  end;
+
+  TLeftBracket = class(TExprWord)
+    function GetVarType: TVarType; override;
+  end;
+
+  TRightBracket = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TComma = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  PString = ^string;
+
+  TStringVariable = class(TExprWord)
+  private
+    FValue: PString;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string; AValue: PString);
+  end;
+
+  TFunction = class(TExprWord)
+  private
+    FIsOper: boolean;
+    FOperPrec: Integer;
+    FNFunctionArg: Integer;
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+    function GetIsOper: boolean; override;
+    function GetNFunctionArg: Integer; override;
+  public
+    constructor Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer);
+    constructor CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+    property OperPrec: Integer read FOperPrec;
+  end;
+
+  TVaryingFunction = class(TFunction)
+    // Functions that can vary for ex. random generators
+    // should be TVaryingFunction to be sure that they are
+    // always evaluated
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TBooleanFunction = class(TFunction)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TOper = (op_eq, op_gt, op_lt, op_ge, op_le, op_in);
+
+const
+  ListChar = ','; { the delimiter used with the 'in' operator: e.g.,
+    ('a' in 'a,b') =True
+    ('c' in 'a,b') =False }
+
+type
+  TSimpleStringFunction = class(TFunction)
+  private
+    FStringFunc: TStringFunc;
+    FLeftArg: TExprWord;
+    FRightArg: TExprWord;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName, Descr: string; AStringFunc: TStringFunc;
+      ALeftArg, ARightArg: TExprWord);
+    function Evaluate: Double;
+    property StringFunc: TStringFunc read FStringFunc;
+  end;
+
+  TVaryingStringFunction = class(TSimpleStringFunction)
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TLogicalStringOper = class(TSimpleStringFunction)
+  protected
+    function GetVarType: TVarType; override;
+  public
+    constructor Create(AOper: string; ALeftArg: TExprWord;
+      ARightArg: TExprWord);
+  end;
+
+procedure _Variable(Param: PExpressionRec);
+
+// procedure _StringFunc(Param: PExpressionRec);
+
+implementation
+
+// function _StrIn(sLookfor, sData: string): Double;
+
+// function _StrInt(a, b: string): Double;
+
+function isNan(const d: Double): boolean;
+begin
+  Result := comp(d) = comp(Nan);
+  // slower alternative: CompareMem(@d, @Nan, SizeOf(Double))
+end;
+
+procedure _Variable(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := Args[0]^;
+end;
+
+procedure _StringFunc(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := TSimpleStringFunction(ExprWord).Evaluate;
+end;
+
+function _StrInt(a, b: string): Double;
+begin
+  Result := StrToInt(a);
+end;
+
+function _StrEq(s1, s2: string): Double;
+begin
+  Result := Byte(s1 = s2);
+end;
+
+function _StrGt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 > s2);
+end;
+
+function _Strlt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 < s2);
+end;
+
+function _StrGe(s1, s2: string): Double;
+begin
+  Result := Byte(s1 >= s2);
+end;
+
+function _Strle(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <= s2);
+end;
+
+function _Strne(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <> s2);
+end;
+
+function _StrIn(sLookfor, sData: string): Double;
+var
+  loop: Integer;
+  subString: string;
+begin
+  Result := 0;
+  loop := pos(ListChar, sData);
+  while loop > 0 do
+  begin
+    subString := Copy(sData, 1, loop - 1);
+    sData := Copy(sData, loop + 1, Length(sData));
+    if subString = sLookfor then
+    begin
+      Result := 1;
+      break;
+    end;
+    loop := pos(ListChar, sData);
+  end;
+  if sLookfor = sData then
+    Result := 1;
+end;
+
+{ TExpressionWord }
+
+function TExprWord.AsPointer: PDouble;
+begin
+  Result := nil;
+end;
+
+constructor TExprWord.Create(AName: string; ADoubleFunc: TDoubleFunc);
+begin
+  FName := LowerCase(AName);
+  FDoubleFunc := ADoubleFunc;
+end;
+
+function TExprWord.GetAsString: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetCanVary: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetDescription: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetIsOper: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetIsVariable: boolean;
+begin
+  Result := @FDoubleFunc = @_Variable
+end;
+
+function TExprWord.GetNFunctionArg: Integer;
+begin
+  Result := 0;
+end;
+
+function TExprWord.GetVarType: TVarType;
+begin
+  Result := vtDouble;
+end;
+
+{ TDoubleConstant }
+
+function TDoubleConstant.AsPointer: PDouble;
+begin
+  Result := @FValue;
+end;
+
+constructor TDoubleConstant.Create(AName, AValue: string);
+begin
+  inherited Create(AName, _Variable);
+  if AValue <> '' then
+    FValue := StrToFloat(AValue)
+  else
+    FValue := Nan;
+end;
+
+constructor TDoubleConstant.CreateAsDouble(AName: string; AValue: Double);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+{ TStringConstant }
+
+function TStringConstant.GetAsString: string;
+begin
+  Result := FValue;
+end;
+
+constructor TStringConstant.Create(AValue: string);
+begin
+  inherited Create(AValue, _Variable);
+  if (AValue[1] = '''') and (AValue[Length(AValue)] = '''') then
+    FValue := Copy(AValue, 2, Length(AValue) - 2)
+  else
+    FValue := AValue;
+end;
+
+function TStringConstant.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+{ TDoubleVariable }
+
+function TDoubleVariable.AsPointer: PDouble;
+begin
+  Result := FValue;
+end;
+
+constructor TDoubleVariable.Create(AName: string; AValue: PDouble);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TDoubleVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TFunction }
+
+constructor TFunction.Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer);
+begin
+  FDescription := Descr;
+  CreateOper(AName, ADoubleFunc, ANFunctionArg, False, 0);
+  // to increase compatibility don't use default parameters
+end;
+
+constructor TFunction.CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+begin
+  inherited Create(AName, ADoubleFunc);
+  FNFunctionArg := ANFunctionArg;
+  if FNFunctionArg > MaxArg then
+    raise EParserException.Create('Too many arguments');
+  FIsOper := AIsOper;
+  FOperPrec := AOperPrec;
+end;
+
+function TFunction.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+function TFunction.GetIsOper: boolean;
+begin
+  Result := FIsOper;
+end;
+
+function TFunction.GetNFunctionArg: Integer;
+begin
+  Result := FNFunctionArg;
+end;
+
+{ TLeftBracket }
+
+function TLeftBracket.GetVarType: TVarType;
+begin
+  Result := vtLeftBracket;
+end;
+
+{ TExpressList }
+
+function TExpressList.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Result := StrIComp(Pchar(Key1), Pchar(Key2));
+end;
+
+function TExpressList.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := Pchar(TExprWord(Item).Name);
+end;
+
+{ TRightBracket }
+
+function TRightBracket.GetVarType: TVarType;
+begin
+  Result := vtRightBracket;
+end;
+
+{ TComma }
+
+function TComma.GetVarType: TVarType;
+begin
+  Result := vtComma;
+end;
+
+{ TExprCollection }
+
+procedure TExprCollection.Check;
+var
+  brCount, I: Integer;
+begin
+  brCount := 0;
+  for I := 0 to Count - 1 do
+  begin
+    case TExprWord(Items[I]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+  end;
+  if brCount <> 0 then
+    raise EParserException.Create('Unequal brackets');
+end;
+
+procedure TExprCollection.EraseExtraBrackets;
+var
+  I: Integer;
+  brCount: Integer;
+begin
+  if (TExprWord(Items[0]).VarType = vtLeftBracket) then
+  begin
+    brCount := 1;
+    I := 1;
+    while (I < Count) and (brCount > 0) do
+    begin
+      case TExprWord(Items[I]).VarType of
+        vtLeftBracket:
+          Inc(brCount);
+        vtRightBracket:
+          Dec(brCount);
+      end;
+      Inc(I);
+    end;
+    if (brCount = 0) and (I = Count) and
+      (TExprWord(Items[I - 1]).VarType = vtRightBracket) then
+    begin
+      for I := 0 to Count - 3 do
+        Items[I] := Items[I + 1];
+      Count := Count - 2;
+      EraseExtraBrackets; // Check if there are still too many brackets
+    end;
+  end;
+end;
+
+function TExprCollection.NextOper(IStart: Integer): Integer;
+var
+  brCount: Integer;
+begin
+  brCount := 0;
+  Result := IStart;
+  while (Result < Count) and
+    ((brCount > 0) or (TExprWord(Items[Result]).NFunctionArg <= 0)) do
+  begin
+    case TExprWord(Items[Result]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+    Inc(Result);
+  end;
+end;
+
+{ TStringVariable }
+
+function TStringVariable.GetAsString: string;
+begin
+  if (FValue^[1] = '''') and (FValue^[Length(FValue^)] = '''') then
+    Result := Copy(FValue^, 2, Length(FValue^) - 2)
+  else
+    Result := FValue^
+end;
+
+constructor TStringVariable.Create(AName: string; AValue: PString);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TStringVariable.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+function TStringVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TLogicalStringOper }
+
+constructor TLogicalStringOper.Create(AOper: string;
+  ALeftArg, ARightArg: TExprWord);
+begin
+  if AOper = '=' then
+    FStringFunc := @_StrEq
+  else if AOper = '>' then
+    FStringFunc := @_StrGt
+  else if AOper = '<' then
+    FStringFunc := @_Strlt
+  else if AOper = '>=' then
+    FStringFunc := @_StrGe
+  else if AOper = '<=' then
+    FStringFunc := @_Strle
+  else if AOper = '<>' then
+    FStringFunc := @_Strne
+  else if AOper = 'in' then
+    FStringFunc := @_StrIn
+  else
+    raise EParserException.Create(AOper + ' is not a valid string operand');
+  inherited Create(AOper, '', StringFunc, ALeftArg, ARightArg);
+end;
+
+function TLogicalStringOper.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TBooleanFunction }
+
+function TBooleanFunction.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TGeneratedVariable }
+
+constructor TGeneratedVariable.Create(AName: string);
+begin
+  inherited Create(AName, '');
+  FAsString := '';
+  FVarType := vtDouble;
+end;
+
+function TGeneratedVariable.GetAsString: string;
+begin
+  Result := FAsString;
+end;
+
+function TGeneratedVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+function TGeneratedVariable.GetVarType: TVarType;
+begin
+  Result := FVarType;
+end;
+
+{ TVaryingFunction }
+
+function TVaryingFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TBooleanConstant }
+
+function TBooleanConstant.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TConstant }
+
+constructor TConstant.CreateAsDouble(AName, Descr: string; AValue: Double);
+begin
+  FDescription := Descr;
+  inherited CreateAsDouble(AName, AValue);
+end;
+
+function TConstant.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+{ TSimpleStringFunction }
+
+constructor TSimpleStringFunction.Create(AName, Descr: string;
+  AStringFunc: TStringFunc; ALeftArg, ARightArg: TExprWord);
+begin
+  FStringFunc := @AStringFunc;
+  FLeftArg := ALeftArg;
+  FRightArg := ARightArg;
+  inherited Create(AName, Descr, _StringFunc, 0)
+end;
+
+function TSimpleStringFunction.Evaluate: Double;
+var
+  s1, s2: string;
+begin
+  s1 := FLeftArg.AsString;
+  if FRightArg <> nil then
+    s2 := FRightArg.AsString
+  else
+    s2 := '';
+  Result := StringFunc(s1, s2);
+end;
+
+function TSimpleStringFunction.GetCanVary: boolean;
+begin
+  Result := ((FLeftArg <> nil) and FLeftArg.CanVary) or
+    ((FRightArg <> nil) and FRightArg.CanVary);
+end;
+{ TVaryingStringFunction }
+
+function TVaryingStringFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+end.

contrib/ParseExpression/__history/ParseClass.pas.~2~

@@ -0,0 +1,719 @@
+unit ParseClass;
+
+interface
+
+uses OObjects, SysUtils;
+
+const
+  MaxArg = 1000;
+
+const
+  Nan: Double = 0 / 0;
+function isNan(const d: Double): boolean;
+
+type
+  TVarType = (vtDouble, vtBoolean, vtString, vtLeftBracket,
+    vtRightBracket, vtComma);
+  PDouble = ^Double;
+  EParserException = class(Exception);
+  PExpressionRec = ^TExpressionRec;
+
+  TExprWord = class;
+
+  TArgsArray = record
+    Res: Double;
+    Args: array [0 .. MaxArg - 1] of PDouble;
+    ExprWord: TExprWord; // can be used to notify the object to update
+  end;
+
+  TDoubleFunc = procedure(Expr: PExpressionRec);
+
+  TStringFunc = function(s1, s2: string): Double;
+
+  TExpressionRec = record
+    // used both as linked tree and linked list for maximum evaluation efficiency
+    Oper: TDoubleFunc;
+    Next: PExpressionRec;
+    Res: Double;
+    ExprWord: TExprWord;
+    case Byte of
+      0:
+        (Args: array [0 .. MaxArg - 1] of PDouble;
+          // can be used to notify the object to update
+        );
+      1:
+        (ArgList: array [0 .. MaxArg - 1] of PExpressionRec);
+  end;
+
+  TExprCollection = class(TNoOwnerCollection)
+  public
+    function NextOper(IStart: Integer): Integer;
+    procedure Check;
+    procedure EraseExtraBrackets;
+  end;
+
+  TExprWord = class
+  private
+    FName: string;
+    FDoubleFunc: TDoubleFunc;
+  protected
+    function GetIsOper: boolean; virtual;
+    function GetAsString: string; virtual;
+    function GetIsVariable: boolean;
+    function GetCanVary: boolean; virtual;
+    function GetVarType: TVarType; virtual;
+    function GetNFunctionArg: Integer; virtual;
+    function GetDescription: string; virtual;
+  public
+    constructor Create(AName: string; ADoubleFunc: TDoubleFunc);
+    function AsPointer: PDouble; virtual;
+    property AsString: string read GetAsString;
+    property DoubleFunc: TDoubleFunc read FDoubleFunc;
+    property IsOper: boolean read GetIsOper;
+    property CanVary: boolean read GetCanVary;
+    property isVariable: boolean read GetIsVariable;
+    property VarType: TVarType read GetVarType;
+    property NFunctionArg: Integer read GetNFunctionArg;
+    property Name: string read FName;
+    property Description: string read GetDescription;
+  end;
+
+  TExpressList = class(TSortedCollection)
+  public
+    function KeyOf(Item: Pointer): Pointer; override;
+    function Compare(Key1, Key2: Pointer): Integer; override;
+  end;
+
+  TDoubleConstant = class(TExprWord)
+  private
+    FValue: Double;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: string);
+    constructor CreateAsDouble(AName: string; AValue: Double);
+    // not overloaded to support older Delphi versions
+    property Value: Double read FValue write FValue;
+  end;
+
+  TConstant = class(TDoubleConstant)
+  private
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+  public
+    constructor CreateAsDouble(AName, Descr: string; AValue: Double);
+  end;
+
+  TBooleanConstant = class(TDoubleConstant)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TGeneratedVariable = class(TDoubleConstant)
+  private
+    FAsString: string;
+    FVarType: TVarType;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string);
+    property VarType read GetVarType write FVarType;
+    property AsString: string read GetAsString write FAsString;
+  end;
+
+  TDoubleVariable = class(TExprWord)
+  private
+    FValue: PDouble;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    function AsPointer: PDouble; override;
+    constructor Create(AName: string; AValue: PDouble);
+  end;
+
+  TStringConstant = class(TExprWord)
+  private
+    FValue: string;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+  public
+    constructor Create(AValue: string);
+  end;
+
+  TLeftBracket = class(TExprWord)
+    function GetVarType: TVarType; override;
+  end;
+
+  TRightBracket = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TComma = class(TExprWord)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  PString = ^string;
+
+  TStringVariable = class(TExprWord)
+  private
+    FValue: PString;
+  protected
+    function GetVarType: TVarType; override;
+    function GetAsString: string; override;
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName: string; AValue: PString);
+  end;
+
+  TFunction = class(TExprWord)
+  private
+    FIsOper: boolean;
+    FOperPrec: Integer;
+    FNFunctionArg: Integer;
+    FDescription: string;
+  protected
+    function GetDescription: string; override;
+    function GetIsOper: boolean; override;
+    function GetNFunctionArg: Integer; override;
+  public
+    constructor Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer);
+    constructor CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+      ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+    property OperPrec: Integer read FOperPrec;
+  end;
+
+  TVaryingFunction = class(TFunction)
+    // Functions that can vary for ex. random generators
+    // should be TVaryingFunction to be sure that they are
+    // always evaluated
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TBooleanFunction = class(TFunction)
+  protected
+    function GetVarType: TVarType; override;
+  end;
+
+  TOper = (op_eq, op_gt, op_lt, op_ge, op_le, op_in);
+
+const
+  ListChar = ','; { the delimiter used with the 'in' operator: e.g.,
+    ('a' in 'a,b') =True
+    ('c' in 'a,b') =False }
+
+type
+  TSimpleStringFunction = class(TFunction)
+  private
+    FStringFunc: TStringFunc;
+    FLeftArg: TExprWord;
+    FRightArg: TExprWord;
+  protected
+    function GetCanVary: boolean; override;
+  public
+    constructor Create(AName, Descr: string; AStringFunc: TStringFunc;
+      ALeftArg, ARightArg: TExprWord);
+    function Evaluate: Double;
+    property StringFunc: TStringFunc read FStringFunc;
+  end;
+
+  TVaryingStringFunction = class(TSimpleStringFunction)
+  protected
+    function GetCanVary: boolean; override;
+  end;
+
+  TLogicalStringOper = class(TSimpleStringFunction)
+  protected
+    function GetVarType: TVarType; override;
+  public
+    constructor Create(AOper: string; ALeftArg: TExprWord;
+      ARightArg: TExprWord);
+  end;
+
+procedure _Variable(Param: PExpressionRec);
+
+// procedure _StringFunc(Param: PExpressionRec);
+
+implementation
+
+// function _StrIn(sLookfor, sData: string): Double;
+
+// function _StrInt(a, b: string): Double;
+
+function isNan(const d: Double): boolean;
+begin
+  Result := comp(d) = comp(Nan);
+  // slower alternative: CompareMem(@d, @Nan, SizeOf(Double))
+end;
+
+procedure _Variable(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := Args[0]^;
+end;
+
+procedure _StringFunc(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res := TSimpleStringFunction(ExprWord).Evaluate;
+end;
+
+function _StrInt(a, b: string): Double;
+begin
+  Result := StrToInt(a);
+end;
+
+function _StrEq(s1, s2: string): Double;
+begin
+  Result := Byte(s1 = s2);
+end;
+
+function _StrGt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 > s2);
+end;
+
+function _Strlt(s1, s2: string): Double;
+begin
+  Result := Byte(s1 < s2);
+end;
+
+function _StrGe(s1, s2: string): Double;
+begin
+  Result := Byte(s1 >= s2);
+end;
+
+function _Strle(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <= s2);
+end;
+
+function _Strne(s1, s2: string): Double;
+begin
+  Result := Byte(s1 <> s2);
+end;
+
+function _StrIn(sLookfor, sData: string): Double;
+var
+  loop: Integer;
+  subString: string;
+begin
+  Result := 0;
+  loop := pos(ListChar, sData);
+  while loop > 0 do
+  begin
+    subString := Copy(sData, 1, loop - 1);
+    sData := Copy(sData, loop + 1, Length(sData));
+    if subString = sLookfor then
+    begin
+      Result := 1;
+      break;
+    end;
+    loop := pos(ListChar, sData);
+  end;
+  if sLookfor = sData then
+    Result := 1;
+end;
+
+{ TExpressionWord }
+
+function TExprWord.AsPointer: PDouble;
+begin
+  Result := nil;
+end;
+
+constructor TExprWord.Create(AName: string; ADoubleFunc: TDoubleFunc);
+begin
+  FName := LowerCase(AName);
+  FDoubleFunc := ADoubleFunc;
+end;
+
+function TExprWord.GetAsString: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetCanVary: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetDescription: string;
+begin
+  Result := '';
+end;
+
+function TExprWord.GetIsOper: boolean;
+begin
+  Result := False;
+end;
+
+function TExprWord.GetIsVariable: boolean;
+begin
+  Result := @FDoubleFunc = @_Variable
+end;
+
+function TExprWord.GetNFunctionArg: Integer;
+begin
+  Result := 0;
+end;
+
+function TExprWord.GetVarType: TVarType;
+begin
+  Result := vtDouble;
+end;
+
+{ TDoubleConstant }
+
+function TDoubleConstant.AsPointer: PDouble;
+begin
+  Result := @FValue;
+end;
+
+constructor TDoubleConstant.Create(AName, AValue: string);
+begin
+  inherited Create(AName, _Variable);
+  if AValue <> '' then
+    FValue := StrToFloat(AValue)
+  else
+    FValue := Nan;
+end;
+
+constructor TDoubleConstant.CreateAsDouble(AName: string; AValue: Double);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+{ TStringConstant }
+
+function TStringConstant.GetAsString: string;
+begin
+  Result := FValue;
+end;
+
+constructor TStringConstant.Create(AValue: string);
+begin
+  inherited Create(AValue, _Variable);
+  if (AValue[1] = '''') and (AValue[Length(AValue)] = '''') then
+    FValue := Copy(AValue, 2, Length(AValue) - 2)
+  else
+    FValue := AValue;
+end;
+
+function TStringConstant.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+{ TDoubleVariable }
+
+function TDoubleVariable.AsPointer: PDouble;
+begin
+  Result := FValue;
+end;
+
+constructor TDoubleVariable.Create(AName: string; AValue: PDouble);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TDoubleVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TFunction }
+
+constructor TFunction.Create(AName, Descr: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer);
+begin
+  FDescription := Descr;
+  CreateOper(AName, ADoubleFunc, ANFunctionArg, False, 0);
+  // to increase compatibility don't use default parameters
+end;
+
+constructor TFunction.CreateOper(AName: string; ADoubleFunc: TDoubleFunc;
+  ANFunctionArg: Integer; AIsOper: boolean; AOperPrec: Integer);
+begin
+  inherited Create(AName, ADoubleFunc);
+  FNFunctionArg := ANFunctionArg;
+  if FNFunctionArg > MaxArg then
+    raise EParserException.Create('Too many arguments');
+  FIsOper := AIsOper;
+  FOperPrec := AOperPrec;
+end;
+
+function TFunction.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+function TFunction.GetIsOper: boolean;
+begin
+  Result := FIsOper;
+end;
+
+function TFunction.GetNFunctionArg: Integer;
+begin
+  Result := FNFunctionArg;
+end;
+
+{ TLeftBracket }
+
+function TLeftBracket.GetVarType: TVarType;
+begin
+  Result := vtLeftBracket;
+end;
+
+{ TExpressList }
+
+function TExpressList.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Result := StrIComp(Pchar(Key1), Pchar(Key2));
+end;
+
+function TExpressList.KeyOf(Item: Pointer): Pointer;
+begin
+  Result := Pchar(TExprWord(Item).Name);
+end;
+
+{ TRightBracket }
+
+function TRightBracket.GetVarType: TVarType;
+begin
+  Result := vtRightBracket;
+end;
+
+{ TComma }
+
+function TComma.GetVarType: TVarType;
+begin
+  Result := vtComma;
+end;
+
+{ TExprCollection }
+
+procedure TExprCollection.Check;
+var
+  brCount, I: Integer;
+begin
+  brCount := 0;
+  for I := 0 to Count - 1 do
+  begin
+    case TExprWord(Items[I]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+  end;
+  if brCount <> 0 then
+    raise EParserException.Create('Unequal brackets');
+end;
+
+procedure TExprCollection.EraseExtraBrackets;
+var
+  I: Integer;
+  brCount: Integer;
+begin
+  if (TExprWord(Items[0]).VarType = vtLeftBracket) then
+  begin
+    brCount := 1;
+    I := 1;
+    while (I < Count) and (brCount > 0) do
+    begin
+      case TExprWord(Items[I]).VarType of
+        vtLeftBracket:
+          Inc(brCount);
+        vtRightBracket:
+          Dec(brCount);
+      end;
+      Inc(I);
+    end;
+    if (brCount = 0) and (I = Count) and
+      (TExprWord(Items[I - 1]).VarType = vtRightBracket) then
+    begin
+      for I := 0 to Count - 3 do
+        Items[I] := Items[I + 1];
+      Count := Count - 2;
+      EraseExtraBrackets; // Check if there are still too many brackets
+    end;
+  end;
+end;
+
+function TExprCollection.NextOper(IStart: Integer): Integer;
+var
+  brCount: Integer;
+begin
+  brCount := 0;
+  Result := IStart;
+  while (Result < Count) and
+    ((brCount > 0) or (TExprWord(Items[Result]).NFunctionArg <= 0)) do
+  begin
+    case TExprWord(Items[Result]).VarType of
+      vtLeftBracket:
+        Inc(brCount);
+      vtRightBracket:
+        Dec(brCount);
+    end;
+    Inc(Result);
+  end;
+end;
+
+{ TStringVariable }
+
+function TStringVariable.GetAsString: string;
+begin
+  if (FValue^[1] = '''') and (FValue^[Length(FValue^)] = '''') then
+    Result := Copy(FValue^, 2, Length(FValue^) - 2)
+  else
+    Result := FValue^
+end;
+
+constructor TStringVariable.Create(AName: string; AValue: PString);
+begin
+  inherited Create(AName, _Variable);
+  FValue := AValue;
+end;
+
+function TStringVariable.GetVarType: TVarType;
+begin
+  Result := vtString;
+end;
+
+function TStringVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TLogicalStringOper }
+
+constructor TLogicalStringOper.Create(AOper: string;
+  ALeftArg, ARightArg: TExprWord);
+begin
+  if AOper = '=' then
+    FStringFunc := @_StrEq
+  else if AOper = '>' then
+    FStringFunc := @_StrGt
+  else if AOper = '<' then
+    FStringFunc := @_Strlt
+  else if AOper = '>=' then
+    FStringFunc := @_StrGe
+  else if AOper = '<=' then
+    FStringFunc := @_Strle
+  else if AOper = '<>' then
+    FStringFunc := @_Strne
+  else if AOper = 'in' then
+    FStringFunc := @_StrIn
+  else
+    raise EParserException.Create(AOper + ' is not a valid string operand');
+  inherited Create(AOper, '', StringFunc, ALeftArg, ARightArg);
+end;
+
+function TLogicalStringOper.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TBooleanFunction }
+
+function TBooleanFunction.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TGeneratedVariable }
+
+constructor TGeneratedVariable.Create(AName: string);
+begin
+  inherited Create(AName, '');
+  FAsString := '';
+  FVarType := vtDouble;
+end;
+
+function TGeneratedVariable.GetAsString: string;
+begin
+  Result := FAsString;
+end;
+
+function TGeneratedVariable.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+function TGeneratedVariable.GetVarType: TVarType;
+begin
+  Result := FVarType;
+end;
+
+{ TVaryingFunction }
+
+function TVaryingFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+{ TBooleanConstant }
+
+function TBooleanConstant.GetVarType: TVarType;
+begin
+  Result := vtBoolean;
+end;
+
+{ TConstant }
+
+constructor TConstant.CreateAsDouble(AName, Descr: string; AValue: Double);
+begin
+  FDescription := Descr;
+  inherited CreateAsDouble(AName, AValue);
+end;
+
+function TConstant.GetDescription: string;
+begin
+  Result := FDescription;
+end;
+
+{ TSimpleStringFunction }
+
+constructor TSimpleStringFunction.Create(AName, Descr: string;
+  AStringFunc: TStringFunc; ALeftArg, ARightArg: TExprWord);
+begin
+  FStringFunc := @AStringFunc;
+  FLeftArg := ALeftArg;
+  FRightArg := ARightArg;
+  inherited Create(AName, Descr, _StringFunc, 0)
+end;
+
+function TSimpleStringFunction.Evaluate: Double;
+var
+  s1, s2: string;
+begin
+  s1 := FLeftArg.AsString;
+  if FRightArg <> nil then
+    s2 := FRightArg.AsString
+  else
+    s2 := '';
+  Result := StringFunc(s1, s2);
+end;
+
+function TSimpleStringFunction.GetCanVary: boolean;
+begin
+  Result := ((FLeftArg <> nil) and FLeftArg.CanVary) or
+    ((FRightArg <> nil) and FRightArg.CanVary);
+end;
+{ TVaryingStringFunction }
+
+function TVaryingStringFunction.GetCanVary: boolean;
+begin
+  Result := True;
+end;
+
+end.

contrib/ParseExpression/__history/oObjects.pas.~1~

@@ -0,0 +1,203 @@
+unit OObjects;
+
+interface
+
+uses Classes;
+
+const
+
+  { TOCollection interfaces between OWL TCollection and VCL TList }
+  MaxCollectionSize = Maxint div (SizeOf(Integer) * 2);
+
+type
+  TOCollection = class(TList)
+  public
+    constructor Create(ACapacity: Integer);
+    procedure AtFree(Index: Integer);
+    procedure FreeAll;
+    procedure DoFree(Item: Pointer);
+    procedure FreeItem(Item: Pointer); virtual;
+    destructor Destroy; override;
+  end;
+
+  TNoOwnerCollection = class(TOCollection)
+  public
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+  { TSortedCollection object }
+
+  TSortedCollection = class(TOCollection)
+  public
+    Duplicates: Boolean;
+    constructor Create(ACapacity: Integer);
+    function Compare(Key1, Key2: Pointer): Integer; virtual; abstract;
+    function IndexOf(Item: Pointer): Integer; virtual;
+    procedure Add(Item: Pointer); virtual;
+    procedure AddReplace(Item: Pointer); virtual;
+    { if duplicate then replace the duplicate else add }
+    function KeyOf(Item: Pointer): Pointer; virtual;
+    function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
+  end;
+
+  { TStrCollection object }
+
+  TStrCollection = class(TSortedCollection)
+  public
+    function Compare(Key1, Key2: Pointer): Integer; override;
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+implementation
+
+uses SysUtils;
+
+constructor TOCollection.Create(ACapacity: Integer);
+begin
+  inherited Create;
+  SetCapacity(ACapacity);
+  { Delta is automatic in TList }
+end;
+
+destructor TOCollection.Destroy;
+begin
+  FreeAll;
+  inherited Destroy;
+end;
+
+procedure TOCollection.AtFree(Index: Integer);
+var
+  Item: Pointer;
+begin
+  Item := Items[Index];
+  Delete(Index);
+  FreeItem(Item);
+end;
+
+procedure TOCollection.FreeAll;
+var
+  I: Integer;
+begin
+  try
+    for I := 0 to Count - 1 do
+      FreeItem(Items[I]);
+  finally
+    Count := 0;
+  end;
+end;
+
+procedure TOCollection.DoFree(Item: Pointer);
+begin
+  AtFree(IndexOf(Item));
+end;
+
+procedure TOCollection.FreeItem(Item: Pointer);
+begin
+  if (Item <> nil) then
+    with TObject(Item) as TObject do
+      Free;
+end;
+
+{ ----------------------------------------------------------------virtual;
+  Implementing TNoOwnerCollection
+  ----------------------------------------------------------------- }
+
+procedure TNoOwnerCollection.FreeItem(Item: Pointer);
+begin
+end;
+
+{ TSortedCollection }
+
+{$IFDEF maxComp}
+
+constructor TSortedCollection.Create(ACapacity, ADelta: Integer);
+begin
+  inherited Create(ACapacity, ADelta);
+  Duplicates := False;
+end;
+{$ELSE}
+
+constructor TSortedCollection.Create(ACapacity: Integer);
+begin
+  inherited Create(ACapacity);
+  Duplicates := False;
+end;
+{$ENDIF}
+
+function TSortedCollection.IndexOf(Item: Pointer): Integer;
+var
+  I: Integer;
+begin
+  IndexOf := -1;
+  if Search(KeyOf(Item), I) then
+  begin
+    if Duplicates then
+      while (I < Count) and (Item <> Items[I]) do
+        Inc(I);
+    if I < Count then
+      IndexOf := I;
+  end;
+end;
+
+procedure TSortedCollection.AddReplace(Item: Pointer);
+var
+  Index: Integer;
+begin
+  if Search(KeyOf(Item), Index) then
+    Delete(Index);
+  Add(Item);
+end;
+
+procedure TSortedCollection.Add(Item: Pointer);
+var
+  I: Integer;
+begin
+  if not Search(KeyOf(Item), I) or Duplicates then
+    Insert(I, Item);
+end;
+
+function TSortedCollection.KeyOf(Item: Pointer): Pointer;
+begin
+  KeyOf := Item;
+end;
+
+function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
+var
+  L, H, I, C: Integer;
+begin
+  Search := False;
+  L := 0;
+  H := Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := Compare(KeyOf(Items[I]), Key);
+    if C < 0 then
+      L := I + 1
+    else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Search := True;
+        if not Duplicates then
+          L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+{ TStrCollection }
+
+function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Compare := StrComp(PAnsiChar(Key1), PAnsiChar(Key2));
+end;
+
+procedure TStrCollection.FreeItem(Item: Pointer);
+begin
+  StrDispose(PAnsiChar(Item));
+end;
+
+end.

contrib/ParseExpression/oObjects.pas

@@ -0,0 +1,203 @@
+unit OObjects;
+
+interface
+
+uses Classes;
+
+const
+
+  { TOCollection interfaces between OWL TCollection and VCL TList }
+  MaxCollectionSize = Maxint div (SizeOf(Integer) * 2);
+
+type
+  TOCollection = class(TList)
+  public
+    constructor Create(ACapacity: Integer);
+    procedure AtFree(Index: Integer);
+    procedure FreeAll;
+    procedure DoFree(Item: Pointer);
+    procedure FreeItem(Item: Pointer); virtual;
+    destructor Destroy; override;
+  end;
+
+  TNoOwnerCollection = class(TOCollection)
+  public
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+  { TSortedCollection object }
+
+  TSortedCollection = class(TOCollection)
+  public
+    Duplicates: Boolean;
+    constructor Create(ACapacity: Integer);
+    function Compare(Key1, Key2: Pointer): Integer; virtual; abstract;
+    function IndexOf(Item: Pointer): Integer; virtual;
+    procedure Add(Item: Pointer); virtual;
+    procedure AddReplace(Item: Pointer); virtual;
+    { if duplicate then replace the duplicate else add }
+    function KeyOf(Item: Pointer): Pointer; virtual;
+    function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
+  end;
+
+  { TStrCollection object }
+
+  TStrCollection = class(TSortedCollection)
+  public
+    function Compare(Key1, Key2: Pointer): Integer; override;
+    procedure FreeItem(Item: Pointer); override;
+  end;
+
+implementation
+
+uses SysUtils, AnsiStrings;
+
+constructor TOCollection.Create(ACapacity: Integer);
+begin
+  inherited Create;
+  SetCapacity(ACapacity);
+  { Delta is automatic in TList }
+end;
+
+destructor TOCollection.Destroy;
+begin
+  FreeAll;
+  inherited Destroy;
+end;
+
+procedure TOCollection.AtFree(Index: Integer);
+var
+  Item: Pointer;
+begin
+  Item := Items[Index];
+  Delete(Index);
+  FreeItem(Item);
+end;
+
+procedure TOCollection.FreeAll;
+var
+  I: Integer;
+begin
+  try
+    for I := 0 to Count - 1 do
+      FreeItem(Items[I]);
+  finally
+    Count := 0;
+  end;
+end;
+
+procedure TOCollection.DoFree(Item: Pointer);
+begin
+  AtFree(IndexOf(Item));
+end;
+
+procedure TOCollection.FreeItem(Item: Pointer);
+begin
+  if (Item <> nil) then
+    with TObject(Item) as TObject do
+      Free;
+end;
+
+{ ----------------------------------------------------------------virtual;
+  Implementing TNoOwnerCollection
+  ----------------------------------------------------------------- }
+
+procedure TNoOwnerCollection.FreeItem(Item: Pointer);
+begin
+end;
+
+{ TSortedCollection }
+
+{$IFDEF maxComp}
+
+constructor TSortedCollection.Create(ACapacity, ADelta: Integer);
+begin
+  inherited Create(ACapacity, ADelta);
+  Duplicates := False;
+end;
+{$ELSE}
+
+constructor TSortedCollection.Create(ACapacity: Integer);
+begin
+  inherited Create(ACapacity);
+  Duplicates := False;
+end;
+{$ENDIF}
+
+function TSortedCollection.IndexOf(Item: Pointer): Integer;
+var
+  I: Integer;
+begin
+  IndexOf := -1;
+  if Search(KeyOf(Item), I) then
+  begin
+    if Duplicates then
+      while (I < Count) and (Item <> Items[I]) do
+        Inc(I);
+    if I < Count then
+      IndexOf := I;
+  end;
+end;
+
+procedure TSortedCollection.AddReplace(Item: Pointer);
+var
+  Index: Integer;
+begin
+  if Search(KeyOf(Item), Index) then
+    Delete(Index);
+  Add(Item);
+end;
+
+procedure TSortedCollection.Add(Item: Pointer);
+var
+  I: Integer;
+begin
+  if not Search(KeyOf(Item), I) or Duplicates then
+    Insert(I, Item);
+end;
+
+function TSortedCollection.KeyOf(Item: Pointer): Pointer;
+begin
+  KeyOf := Item;
+end;
+
+function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
+var
+  L, H, I, C: Integer;
+begin
+  Search := False;
+  L := 0;
+  H := Count - 1;
+  while L <= H do
+  begin
+    I := (L + H) shr 1;
+    C := Compare(KeyOf(Items[I]), Key);
+    if C < 0 then
+      L := I + 1
+    else
+    begin
+      H := I - 1;
+      if C = 0 then
+      begin
+        Search := True;
+        if not Duplicates then
+          L := I;
+      end;
+    end;
+  end;
+  Index := L;
+end;
+
+{ TStrCollection }
+
+function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
+begin
+  Compare := AnsiStrings.StrComp(PAnsiChar(Key1), PAnsiChar(Key2));
+end;
+
+procedure TStrCollection.FreeItem(Item: Pointer);
+begin
+  AnsiStrings.StrDispose(PAnsiChar(Item));
+end;
+
+end.

contrib/ParseExpression/readme.txt

@@ -0,0 +1,120 @@
+----- TExpressionParser -----
+
+A flexible and fast expression parser object for logical and 
+mathematical functions.
+Author: Egbert van Nes
+Status: Freeware with source
+Version: 1.2
+Delphi version: D4 and D5 (probably usable for D2 and D3 too)
+Date: April 2002
+
+Download Delphi 4/5 source code (17K)
+
+
+Desciption
+The fast evaluation algorithm ('pseudo-compiler' generating a linked 
+list that evaluates fast) is based upon TParser - an extremely fast 
+component for parsing and evaluating mathematical expressions ('pseudo-
+compiled' code is only 40-80% slower than compiled Delphi code).
+
+See also: http://www.datalog.ro/delphi/parser.html (by Renate Schaaf,
+1993; Alin Flaider, 1996; Version 9-10: Stefan Hoffmeister, 1996-1997)
+
+I used that valuable free parser for some years but needed to 
+add logical operands, which was more difficult for me than rewriting 
+the parser.
+
+TExpressionParser is approximately equally fast in evaluating 
+expressions as TParser, but the compiling is made object oriented, 
+and programmed recursively, requiring much less code and making it 
+easier to customize the parser.
+From version 1.1 on optimization is added, making repeated evaluation 
+often even faster.
+Furthermore, there are several operands added: 
+  comparison: > < <> = <= >= (work also on strings) 
+  logical: and or xor not 
+  factorial: ! 
+  percentage: % 
+  assign to variables: := 
+
+User defined functions can have maximal maxArg (=4) parameters 
+set MaxArg (in unit ParseClass) to a higher value if needed.
+
+The required format of the expression is Pascal style (optionally
+C++ style operands are also supported) with the following additional
+operands: 
+  factorial (x!) 
+  power (x^y) 
+  percentage (x%)
+
+Implicit multiplying is not supported: e.g. (X+1)(24-3) generates 
+a syntax error and should be replaced by (x+1)*(24-3)
+
+Logical functions evaluate in 0 if False and 1 if True The AsString 
+property returns True/False if the expression is logical.
+
+The comparison functions (> <> < etc.) work also with string constants
+('string') and string variables. These comparisons are not case 
+sensitive.
+
+The precedence of the operands is little different from Pascal 
+(Delphi), giving a lower precedence to logical operands, as these 
+by default only act on Booleans (and not on integers like in Pascal). 
+This behavior is easily adjustable. 
+  (highest): ! -x +x % 
+  ^ 
+  * / div mod 
+  + - 
+  > >= < <= <> = 
+  not 
+  or and xor 
+  (lowest): := 
+This precedence order is easily customizable by overriding/changing 
+the FillExpressList method (the precedence order is defined there).
+
+You can use user-defined variables in the expressions and also assign 
+to variables using the := operand
+
+The use of this object is very simple, therefore it doesn't seem 
+necessary to make a non-visual component of it.
+
+NEW IN VERSION 1.1: 
+Optimization, increasing the efficiency for evaluating an expression 
+many times (with a variable in the expression). The 'compiler' then
+removes constant expressions and replaces these with the evaluated
+result.
+e.g. 4*4*x becomes 16*x
+     ln(5)+3*x becomes 1.609437912+3*x
+
+limitation:
+     4*x+3+3+5 evaluates as 4*x+3+3+5 (due to precedence rules)
+whereas:
+     4*x+(3+3+5) becomes 4*x+11 (use brackets to be sure that constant 
+     expressions are removed by the compiler)
+
+
+
+
+New in Version 1.1.1
+- Evaluation of hexadecimal numbers (e.g. $FF, the $-sign for hexadecimals is adjustable) and show result as hex. 
+- Changes in class implementation 
+
+
+
+New in Version 1.1.2
+- The variable DecimalSeparator (SysUtils) now determines the decimal separator. If the decimal separator is a comma
+  then the function argument separator is a semicolon ';' 
+
+
+New in Version 1.1.3
+
+- Rearranged the classes, added a basic class TCustomParser for maximal flexibility. 
+- Multiline formula parser (a contribution by Xavier Mor-Mur, xmormur@telepolis.com, xmormur@teleline.es) 
+- New example application for multiline formula's 
+- ++ and -- support (like C++)
+
+Contact with the author
+author: Egbert van Nes
+email: Egbert.vanNes@aqec.wkao.wau.nl
+
+You are encouraged to send bug reports.