Cesar Romero ha scritto:
>
>>
>> Why not use a dual approach ? Use RTTI where appropriate, and use the
>> manual
>> approach where RTTI is not possible ?
>
> Tha was the way that I did in DePO, dual, and always something was
> missed... So I feel that is better to keep all in one way...
There's a third way: use rtti to create a list of field values of the
object and use this "group of value types" in the framework as you would
do with the manual approach, with the ability to clone the objects and
so on.... I've did this with Cosimo De Michele for his second version of
Depo, but never had the time to continue to work on the project,
probably Cosimo is building on this. The
approach is very interesting and promising.
to give you the idea here is the interface part:
type
EIncompatibleProperty = Exception;
{ TPropertiesInfoList }
TPropertiesInfoList = class(TObject)
private
FList: PPropList;
FCount: Integer;
FSize: Integer;
FClassName: string;
function Get(Index: Integer): PPropInfo;
function GetInfo(const Index: string): PPropInfo;
public
constructor Create(AObjectClass: TClass; Filter: TTypeKinds);
destructor Destroy; override;
function Find(const AName: string): PPropInfo;
property Count: Integer read FCount;
property Items[Index: Integer]: PPropInfo read Get;
property PropInfos[const Index: string]: PPropInfo read GetInfo;
default;
property ClassName: string read FClassName;
end;
{ TSnapPropertyValue }
TSnapPropertyValue = class
private
fName: string;
public
property Name: string read fName;
function AsString: string; virtual; abstract;
procedure SetValueTo(AObject: TObject; p: PPropInfo); virtual; abstract;
function Equals(AObjectValue: TSnapPropertyValue): boolean;
end;
{ TSnapStringValue }
TSnapStringValue = class(TSnapPropertyValue)
private
FValue: string;
public
constructor Create(const AName: string; const AValue: string);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: string read FValue;
end;
{ TSnapIntegerValue }
TSnapIntegerValue = class(TSnapPropertyValue)
private
FValue: integer;
public
constructor Create(const AName: string; const AValue: integer);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: integer read FValue;
end;
{ TSnapInt64Value }
TSnapInt64Value = class(TSnapPropertyValue)
private
FValue: int64;
public
constructor Create(const AName: string; const AValue: int64);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: int64 read FValue;
end;
{ TSnapExtendedValue }
TSnapExtendedValue = class(TSnapPropertyValue)
private
FValue: Extended;
public
constructor Create(const AName: string; const AValue: Extended);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: Extended read FValue;
end;
{ TSnapCurrencyValue }
TSnapCurrencyValue = class(TSnapPropertyValue)
private
FValue: Currency;
public
constructor Create(const AName: string; const AValue: Currency);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: Currency read FValue;
end;
{ TSnapDateTimeValue }
TSnapDateTimeValue = class(TSnapPropertyValue)
private
FValue: TDateTime;
public
constructor Create(const AName: string; const AValue: TDateTime);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: TDateTime read FValue;
end;
{ TSnapDoubleValue }
TSnapDoubleValue = class(TSnapPropertyValue)
private
FValue: Double;
public
constructor Create(const AName: string; const AValue: Double);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: Double read FValue;
end;
{ TSnapObjectValue }
TSnapObjectValue = class(TSnapPropertyValue)
private
FValue: TObject;
public
constructor Create(const AName: string; const AValue: TObject);
procedure SetValueTo(AObject: TObject; p: PPropInfo); override;
function AsString: string; override;
property Value: TObject read FValue;
end;
{ TSnapReflector }
TSnapReflector = class(TObject)
private
FPropList: TPropertiesInfoList;
protected
function NewProperty(const p: PPropInfo; var AObject:
TObject):TSnapPropertyValue;
public
constructor Create;
destructor Destroy; override;
property PropertyList: TPropertiesInfoList read FPropList;
procedure LoadPropertyList(AObject: TObject);
procedure GetPropertyValue(AObject: TObject; const AProperty:
string; AField: TField);
procedure SetPropertyValue(AObject: TObject; const AProperty:
string; AField: TField);
function CreateObjectValue(AObject: TObject; const AProperty:
string): TSnapPropertyValue;
end;
TSnapValuesNotifyEvent = procedure(Sender: TObject; Value:
TSnapPropertyValue) of object;
{ TSnapPropertyValues }
TSnapPropertyValues = class
private
fList: TStringList;
fOnChanged: TSnapValuesNotifyEvent;
fValueSeparator: string;
function GetCount: integer;
function GetItem(Index: Integer): TSnapPropertyValue;
function GetValue(AName: string): TSnapPropertyValue;
procedure SetItem(Index: Integer; const Value: TSnapPropertyValue);
procedure SetValue(AName: string; const Value: TSnapPropertyValue);
protected
procedure ValueChanged(Item: TSnapPropertyValue); virtual;
public
constructor Create; reintroduce; overload; virtual;
destructor Destroy; override;
constructor Create(AEntityObject: TObject; AFieldsMap: TStringList);
overload; virtual;
constructor Create(AEntityObject: TObject; AFieldsMap:
TSnapFieldsMap); overload; virtual;
constructor Create(AEntityObject: TObject); overload; virtual;
//TODO: test it!
constructor Create(APropertyValues: TSnapPropertyValues;
AListOfFields: TStringlist); overload; virtual;
procedure LoadFromFieldsMap(AEntityObject: TObject; AFieldsMap:
TSnapFieldsMap); virtual;
procedure SetObjectProperties(AObject: TObject);
procedure Clear;
procedure Add(AName: string; AValue: TSnapPropertyValue);
function Find(AName: string): TSnapPropertyValue;
function AsString: string;
property Items[Index: Integer]: TSnapPropertyValue read GetItem
write SetItem; default;
property Value[AName: string]: TSnapPropertyValue read GetValue
write SetValue;
property OnChanged: TSnapValuesNotifyEvent read fOnChanged write
fOnChanged;
property ValueSeparator: string read fValueSeparator write
fValueSeparator;
property Count: integer read GetCount;
end;
Procedure CloneObject(FromObject, ToObject: TObject);
Function SnapReflector: TSnapReflector;
If you want I can send you
the relevant code and the fpcunit tests. I have just to clean it up a
bit to remove the dependencies on other units
Ciao, Dean
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
