Your-own-evaluator


            Title: Your own evaluator
Question: Having a string logic that does your checking or setting of your component propertys
Answer:
// Please vote or leafe messages so we all learn from eachother :)
The example is a project that i reused 
http://www.xs4all.nl/~suusie/Pieter/Programs/MapingComponentsToGui.zip
I modified it so you can check and set some propertys in the object. 
the source i posted is pure the object so if you dont want to type or
want to see it all work just check out the component attachment .
Ok heres the deal you have validations on your object that are user controleble.
You can store them like strings and do checking like this 
I made a simple example that explains the use of the object.
If you want to do more validationm you wil have to write a mechanism that wil allow more statements to be saved and executed.
Ik my self used a Collection Class for this ..
Not included in the example .
procedure TForm1.ButtonSetAndCheckClick(Sender: TObject);
var
 LogicParcer: TLogicParcer;
 aVariant,BVariant,CVariant: Variant;
begin
 LogicParcer := TLogicParcer.Create;
 try
 // set the logic parcers eval object to be able to have acces to 
 // those propertys
 LogicParcer.EvalObject := ExampleComponent;
 aVariant := LogicParcer.CalcValue('5 if Vartype(aVariant) varBoolean then
 raise Exception.Create('Invalid if statement');
 BVariant := LogicParcer.CalcValue('4 * 5');
 if Vartype(BVariant) = varEmpty then
 raise Exception.Create('Not a value assigned');
 
 CVariant := LogicParcer.CalcValue('True');
 if Vartype(CVariant) varBoolean then
 raise Exception.Create('Invalid if check statement');
 // this is how you cold parce the logic
 if aVariant then
 LogicParcer.SetPersistentProp('AFloat', 
 ExampleComponent,BVariant);
 if CVariant then
 raise Exception.Create('Error text here ');
 finally
 LogicParcer.free;
 end;
end;
unit LogicParcer;
interface
uses
 Classes, Sysutils; // Graphics, Controls, Forms, Dialogs,
 // StdCtrls;
const
 TokenSet: set of char = ['+', '-', '*', '/', '^', '|', '=', '!', '&', ''];
type
 TLogixType = (ltToken, tlValue, ltRecurse, ltObject, ltFunction);
 TLogixNode = class(TObject)
 LogixType: TLogixType;
 Value: Variant;
 end;
 TLogicParcer = class
 private
 FEvalObject: TPersistent;
 function EvalMax(AString: string): string;
 procedure FindBeginAndEndPosOfBracets(const AValue: string; var Abeginpos, AEndPos: Integer);
 function GetObjectValue(AObject: string): Variant;
 function CalcValueFromlist(Alist: Tlist): Variant;
 function Evalmin(AString: string): string;
 Function EvalToDate(aString : String ) : String ; 
 procedure SetEvalObject(const Value: TPersistent);
 { Private declarations }
 public
 // Easy acces to objects bij string
 function GetPersistentProp(AName: string; aPersistent: TPersistent): Variant;
 procedure SetPersistentProp(AName: string; aPersistent: TPersistent; Value: Variant);
 function CalcValue(AValue: string): Variant;
 // USed in evaluating Object propertys defined lik [SomeProp] including
 // nestled operations like [somePersistendprop.SomeProp
 property EvalObject: TPersistent read FEvalObject write SetEvalObject;
 { Public declarations }
 end;
implementation
uses math, contnrs, TypInfo;
function TLogicParcer.CalcValue(AValue: string): Variant;
var
 AList: Tobjectlist;
 i, y, EndPos: Integer;
 ALogicNode: TLogixNode;
 TempStr: string;
begin
 try
 // spaties strippen
 for i := Length(AValue) downto 1 do
 begin
 if AValue[i] = ' ' then
 delete(AValue, i, 1);
 end;
 AList := Tobjectlist.Create;
 AList.OwnsObjects := False;
 try
 // function Search
 // min
 while Pos('Min', AValue) 0 do
 begin
 i := Pos('min', AValue) + 3;
 FindBeginAndEndPosOfBracets(AValue, i, EndPos);
 TempStr := copy(AValue, i + 1, EndPos - i);
 TempStr := Evalmin(TempStr);
 delete(AValue, i - 3, (EndPos - i) + 5);
 insert(TempStr, AValue, i);
 end;
 // max
 while Pos('Max', AValue) 0 do
 begin
 i := Pos('max', AValue) + 3;
 FindBeginAndEndPosOfBracets(AValue, i, EndPos);
 TempStr := copy(AValue, i + 1, EndPos - i);
 TempStr := Evalmax(TempStr);
 delete(AValue, i - 3, (EndPos - i) + 5);
 insert(TempStr, AValue, i);
 end;
 // ToDate
 while Pos('ToDate', AValue) 0 do
 begin
 i := Pos('ToDate', AValue) + 6;
 FindBeginAndEndPosOfBracets(AValue, i, EndPos);
 TempStr := copy(AValue, i + 1, EndPos - i);
 TempStr := EvalToDate(TempStr);
 delete(AValue, i - 6, (EndPos - i) + 8);
 insert(TempStr, AValue, i-6);
 end;
 i := 1;
 while i begin
 // Brackets Value
 if AValue[i] = '(' then
 begin
 FindBeginAndEndPosOfBracets(AValue, i, EndPos);
 ALogicNode := TLogixNode.Create;
 AList.Add(ALogicNode);
 ALogicNode.LogixType := ltRecurse;
 ALogicNode.Value := copy(AValue, i + 1, EndPos - i);
 ALogicNode.Value := CalcValue(VarToStr(ALogicNode.Value));
 i := EndPos + 2;
 end
 else
 if AValue[i] in TokenSet then // Token value
 begin
 ALogicNode := TLogixNode.Create;
 AList.Add(ALogicNode);
 ALogicNode.LogixType := ltToken;
 TempStr := copy(AValue, i, 1);
 ALogicNode.Value := TempStr;
 Inc(i);
 end
 else
 // object of nummer of boolean
 begin
 TempStr := '';
 while not (AValue[i] in TokenSet + ['(', #0]) do
 begin
 TempStr := TempStr + AValue[i];
 inc(i);
 end;
 ALogicNode := TLogixNode.Create;
 AList.Add(ALogicNode);
 ALogicNode.LogixType := tlValue;
 ALogicNode.Value := '';
 if (UpperCase(tempstr) = 'FALSE') or
 (UpperCase(tempstr) = 'TRUE') then
 begin
 ALogicNode.LogixType := tlValue;
 ALogicNode.Value := (UpperCase(tempstr) = 'TRUE');
 end
 else
 begin
 for y := 1 to Length(tempstr) do
 begin
 // is het een nummer ??
 if not (TempStr[y] in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '.', 'E']) then
 begin
 ALogicNode.Value := GetObjectValue(tempstr);
 ALogicNode.LogixType := ltObject;
 end;
 end;
 // is de waarde gevult ?? zo niet dan is het een Nummer
 if VarToStr(ALogicNode.Value) = '' then
 ALogicNode.Value := StrToFloat(tempstr);
 end;
 end;
 end;
 Result := CalcValueFromlist(AList);
 // end while i finally
 for i := 0 to AList.Count - 1 do
 begin
 TObject(AList[i]).free;
 end;
 AList.free;
 end;
 except
 on e: Exception do
 begin
 Result := E.Message;
 end;
 end;
end;
procedure TLogicParcer.FindBeginAndEndPosOfBracets(const AValue: string; var Abeginpos,
 AEndPos: Integer);
var
 i, BracetsCount: Integer;
begin
 BracetsCount := 0;
 for i := Abeginpos to length(AValue) do
 begin
 if AValue[i] = '(' then
 inc(BracetsCount)
 else if AValue[i] = ')' then
 Dec(BracetsCount);
 if BracetsCount = 0 then
 begin
 AEndPos := i - 1;
 exit;
 end;
 end;
 raise EMathError.Create(Format('bracets not closed in %s', [AValue]));
end;
function TLogicParcer.GetObjectValue(AObject: string): Variant;
var
 i: Integer;
 Day, Jear, Month: Word;
 TempStr, TempMonth: string;
begin
// nul datum 30#12#1899
 if (AObject = '') or (AObject[1] '[') or (AObject[Length(AObject)] ']') then
 exit;
 if POS('#', AObject) 0 then
 begin
 AObject[Length(AObject)] := ' ';
 AObject[1] := ' ';
 for i := 1 to Length(AObject) do
 begin
 if AObject[i] = '#' then AObject[i] := '-';
 end;
 AObject := Trim(AObject);
 if StrToInt(AObject[1] + AObject[2]) = 0 then
 begin
 i := Length(AObject);
 // jaren
 while (AObject[i] in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) do
 begin
 TempStr := AObject[i] + TempStr;
 dec(i);
 end;
 dec(i);
 // maanden
 while (AObject[i] in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) do
 begin
 TempMonth := AObject[i] + TempMonth;
 dec(i);
 end;
 Jear := 1899;
 Month := 12;
 Day := 30;
 Jear := Jear + StrToInt(TempStr);
 Result := EncodeDate(jear, month, day);
 end
 else
 Result := StrToDate(AObject);
 end
 else if AObject = '[TODAY]' then
 result := Date
 else
 begin
 AObject[Length(AObject)] := ' ';
 AObject[1] := ' ';
 AObject := Trim(AObject);
 Result := GetPersistentProp(AObject, FEvalObject);
 end;
 if TVarData(result).VType = varEmpty then
 Result := AObject ;
end;
function TLogicParcer.CalcValueFromlist(Alist: Tlist): Variant;
var
 i: Integer;
begin
 Result := 0;
 // Check
 if Alist.Count = 1 then
 begin
 result := TlogixNode(Alist[0]).Value;
 exit;
 end;
 if VarToStr(TlogixNode(AList[0]).Value) '!' then
 begin
 if Alist.Count if (TLogixNode(Alist[0]).LogixType = lttoken)
 or (TlogixNode(Alist[Alist.Count - 1]).LogixType = lttoken) then
 raise EMathError.Create('Error in Expression Token found at begin or end of list');
 end;
 // berekening
 // '^'
 // '*',
 // '/',
 // '+','-',
 // ,'|','=','!','&',''
 // meneer = machtsVerheffen
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '^' then
 begin
 TLogixNode(AList[i]).Value := Power(TLogixNode(AList[i - 1]).Value, TLogixNode(AList[i + 1]).Value);
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + i);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - i);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // van = vermenigvuldigen
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '*' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value * TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // dalen = Delen
 i := 0;
 while i begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '/' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value / TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 end
 else
 inc(i);
 end
 else
 inc(i);
 end;
 // Wacht doen weniet
 // Op = Optellen
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '+' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value + TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // Antwoord = aftrekken
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '-' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value - TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // Booleanse vergelijking
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if (TLogixNode(AList[i]).Value = '=') or
 (TLogixNode(AList[i]).Value = ' (TLogixNode(AList[i]).Value = '') then
 begin
 if TLogixNode(AList[i - 1]).LogixType = ltToken then
 begin
 if (TLogixNode(AList[i - 1]).Value = ' or (TLogixNode(AList[i - 1]).Value = '') then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value + TLogixNode(AList[i]).Value;
 TLogixNode(AList[i - 1]).free;
 alist.Delete(i - 1);
 dec(i);
 end
 else
 raise EMathError.Create('Not a valid equasion');
 end;
 if TLogixNode(AList[i]).Value = '=' then
 TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value = TLogixNode(AList[i + 1]).Value)
 else if TLogixNode(AList[i]).Value = ' TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value else if TLogixNode(AList[i]).Value = '' then
 TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value TLogixNode(AList[i + 1]).Value)
 else if TLogixNode(AList[i]).Value = ' TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value else if TLogixNode(AList[i]).Value = '=' then
 TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value = TLogixNode(AList[i + 1]).Value)
 else if TLogixNode(AList[i]).Value = '' then
 TLogixNode(AList[i]).Value := (TLogixNode(AList[i - 1]).Value TLogixNode(AList[i + 1]).Value);
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // booleanse operatoren
 // and
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '&' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value and TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // or
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '|' then
 begin
 TLogixNode(AList[i]).Value := TLogixNode(AList[i - 1]).Value or TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 TLogixNode(alist[i - 1]).free;
 Alist.Delete(i - 1);
 dec(i, 2);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 // not
 i := Alist.Count - 1;
 while i = 0 do
 begin
 if TLogixNode(AList[i]).LogixType = ltToken then
 begin
 if TLogixNode(AList[i]).Value = '!' then
 begin
 TLogixNode(AList[i]).Value := not TLogixNode(AList[i + 1]).Value;
 TLogixNode(AList[i]).LogixType := tlValue;
 TLogixNode(alist[i + 1]).free;
 Alist.Delete(i + 1);
 dec(i);
 end
 else
 dec(i);
 end
 else
 dec(i);
 end;
 if Alist.Count 1 then raise EMathError.Create('Error After calc list count 1');
 Result := TLogixNode(Alist[0]).Value;
end;
function TLogicParcer.EvalMax(AString: string): string;
var
 i: Integer;
 a, b: Extended;
 sa, sb: string;
begin
 i := length(AString);
 while not (AString[i] = ',') do
 begin
 sb := AString[i] + sb;
 dec(i);
 if i = 1 then exit;
 end;
 dec(i);
 while not (AString[i] = #0) do
 begin
 sa := AString[i] + sa;
 dec(i);
 end;
 a := StrToFloat(VarToStr(CalcValue(sa)));
 b := StrToFloat(VarToStr(CalcValue(sb)));
 result := FloatToStr(max(a, b));
end;
function TLogicParcer.Evalmin(AString: string): string;
var
 i: Integer;
 a, b: Extended;
 sa, sb: string;
begin
 i := length(AString);
 while not (AString[i] = ',') do
 begin
 sb := AString[i] + sb;
 dec(i);
 if i = 1 then exit;
 end;
 dec(i);
 while not (AString[i] = #0) do
 begin
 sa := AString[i] + sa;
 dec(i);
 end;
 a := StrToFloat(VarToStr(CalcValue(sa)));
 b := StrToFloat(VarToStr(CalcValue(sb)));
 result := FloatToStr(Min(a, b));
end;
procedure TLogicParcer.SetEvalObject(const Value: TPersistent);
begin
 FEvalObject := Value;
end;
procedure TLogicParcer.SetPersistentProp(AName: string; APersistent: TPersistent; Value: Variant);
var
 PropList: PPropList;
 PropCount: Integer;
 ClassTypeInfo: PTypeInfo;
 ClassTypeData: PTypeData;
 i: integer;
 Propname, NextName: string;
begin
 if APersistent = nil then exit;
 ClassTypeInfo := APersistent.ClassInfo;
 ClassTypeData := GetTypeData(ClassTypeInfo);
 PropCount := ClassTypeData.PropCount - 1;
 if pos('.', AName) 0 then
 begin
 Propname := copy(AName, 1, pos('.', AName) - 1);
 NextName := copy(AName, pos('.', AName) + 1, Length(AName) - pos('.', AName) + 1);
 end
 else
 Propname := AName;
 // reserveer geheugen
 GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
 // Error trap
 try
 // Vul de prop list
 GetPropInfos(APersistent.ClassInfo, PropList);
 for i := 0 to PropCount do
 begin
 if (PropList[i]^.Name = Propname) and (NextName = '') then
 case PropList[i]^.PropType^.Kind of
 tkString, tkLString,
 tkWString, tkWChar,
 tkChar:
 begin
 SetStrProp(APersistent, PropList[i], VarToStr(Value));
 end;
 tkInteger,
 tkEnumeration:
 begin
 if VarToStr(Value) '' then
 SetOrdProp(APersistent, PropList[i], StrToInt(VarToStr(Value)));
 end;
 tkFloat:
 begin
 if (PropList[i]^.PropType^.Name = 'TDateTime') then
 SetFloatProp(APersistent, PropList[i], VarToDateTime(Value))
 else
 SetFloatProp(APersistent, PropList[i], StrToFloat(VarToStr(Value)));
 end;
 end; // end case
 // recursion logic
 if PropList[i]^.PropType^.Kind = tkClass then
 if GetObjectProp(APersistent, PropList[i]) is TPersistent then
 begin
 if (PropList[i]^.Name = Propname) and (NextName '') then
 SetPersistentProp(NextName, TPersistent(GetObjectProp(APersistent, PropList[i])), Value);
 end;
 end; // end i
 finally
 FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
 end;
end;
function TLogicParcer.GetPersistentProp(AName: string; APersistent: TPersistent): Variant;
var
 PropList: PPropList;
 PropCount: Integer;
 ClassTypeInfo: PTypeInfo;
 ClassTypeData: PTypeData;
 i: integer;
 Propname, NextName: string;
begin
 if APersistent = nil then exit;
 ClassTypeInfo := APersistent.ClassInfo;
 ClassTypeData := GetTypeData(ClassTypeInfo);
 PropCount := ClassTypeData.PropCount - 1;
 if pos('.', AName) 0 then
 begin
 Propname := copy(AName, 1, pos('.', AName) - 1);
 NextName := copy(AName, pos('.', AName) + 1, Length(AName) - pos('.', AName) + 1);
 end
 else
 Propname := AName;
 // reserveer geheugen
 GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
 // Error trap
 try
 // Vul de prop list
 GetPropInfos(APersistent.ClassInfo, PropList);
 for i := 0 to PropCount do
 begin
 if (PropList[i]^.Name = Propname) and (NextName = '') then
 case PropList[i]^.PropType^.Kind of
 tkString, tkLString,
 tkWString, tkWChar,
 tkChar:
 begin
 Result := GetStrProp(APersistent, PropList[i]);
 end;
 tkInteger,
 tkEnumeration:
 begin
 Result := GetOrdProp(APersistent, PropList[i]);
 end;
 tkFloat:
 begin
 if (PropList[i]^.PropType^.Name = 'TDateTime') then
 Result := VarFromDateTime(GetFloatProp(APersistent, PropList[i]))
 else
 Result := GetFloatProp(APersistent, PropList[i]);
 end;
 end; // end case
 // recursion logic
 if PropList[i]^.PropType^.Kind = tkClass then
 if GetObjectProp(APersistent, PropList[i]) is TPersistent then
 begin
 If (GetObjectProp(APersistent, PropList[i]) is TCollection) and
 (NextName ='Count') then Result := TCollection (GetObjectProp(APersistent, PropList[i])).Count
 else
 if (PropList[i]^.Name = Propname) and (NextName '') then
 Result := GetPersistentProp(NextName, TPersistent(GetObjectProp(APersistent, PropList[i])));
 end;
 end; // end i
 finally
 FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
 end;
end;
function TLogicParcer.EvalToDate(aString: String): String;
var
 i : Integer ;
begin
 Result := VarToStr(CalcValue(aString));
 for i := 1 to length(Result) do
 if result[i] = '-' then result[i] := '#' ;
 Result := '[' + result + ']' ;
end;
end.
Examples Delphi
