Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do I cast a TObject as a TObjectList<T>?

I have a procedure that needs to insert an array of TObjects into to a list. The list can be of any of the supported types, e.g. TObjectList, TObjectList<T>, TROArray, etc.

The procedure looks like this:

type
  TObjectArray = Array of TObject;

...

procedure TMyClass.DoAssignObjectList(const ObjectArray: TObjectArray;
  const DstList: TObject);
var
  i: Integer;
begin
  if DstList is TObjectList then
  begin
    for i := 0 to pred(TObjectList(DstList).Count) do
      TObjectList(DstList).Add(ObjectArray[i]);
  end else
  if DstList is TObjectList<T> then // Obviously this doesn't work
  begin
    for i := 0 to pred(TObjectList<T>(DstList).Count) do
      TObjectList<T>(DstList).Add(ObjectArray[i]);
  end
  else
  begin
    raise Exception.CreateFmt(StrNoDoAssignORMObject, [DstList.ClassName]);
  end;
end;

How can I check that an object is a TObjectList<T> and then add the elements of an array to it?

like image 506
norgepaul Avatar asked Mar 16 '23 21:03

norgepaul


2 Answers

You have to use a bit RTTI to get some more information about the generic type.

The following code uses Spring4D which has some methods for that:

uses 
  ...
  Spring.Reflection;

procedure DoAssignObjectList(const ObjectArray: TObjectArray;
  const DstList: TObject);

  function IsGenericTObjectList(const obj: TObject): Boolean;
  var
    t: TRttiType;
  begin
    t := TType.GetType(obj.ClassInfo);
    Result := t.IsGenericType and (t.GetGenericTypeDefinition = 'TObjectList<>');
  end;

begin
  ...
  if IsGenericTObjectList(DstList) then
  begin
    for i := 0 to pred(TObjectList<TObject>(DstList).Count) do
      TObjectList<TObject>(DstList).Add(ObjectArray[i]);
  ...
end;

Additionally to that you can also get information about the generic parameter type of the list to check if the objects you are putting into it are matching the requirements (only works on a generic type of course):

function GetGenericTObjectListParameter(const obj: TObject): TClass;
var
  t: TRttiType;
begin
  t := TType.GetType(obj.ClassInfo);
  Result := t.GetGenericArguments[0].AsInstance.MetaclassType;
end;
like image 180
Stefan Glienke Avatar answered Mar 28 '23 16:03

Stefan Glienke


As I was writing this question I figured out a way to do this using RTTI. It should work with any list that has a procedure Add(AObject: TObject).

procedure TransferArrayItems(const Instance: TObject;
  const ObjectArray: TObjectArray);
const
  AddMethodName = 'Add';
var
  Found: Boolean;
  LMethod: TRttiMethod;
  LIndex: Integer;
  LParams: TArray<TRttiParameter>;
  i: Integer;
  RTTIContext: TRttiContext;
  RttiType: TRttiType;
begin
  Found := False;
  LMethod := nil;

  if length(ObjectArray) > 0 then
  begin
    RTTIContext := TRttiContext.Create;
    RttiType := RTTIContext.GetType(Instance.ClassInfo);

    for LMethod in RttiType.GetMethods do
    begin
      if SameText(LMethod.Name, AddMethodName) then
      begin
        LParams := LMethod.GetParameters;

        if length(LParams) = 1 then
        begin
          Found := TRUE;

          for LIndex := 0 to length(LParams) - 1 do
          begin
            if LParams[LIndex].ParamType.Handle <> TValue(ObjectArray[0]).TypeInfo
            then
            begin
              Found := False;

              Break;
            end;
          end;
        end;

        if Found then
          Break;
      end;
    end;

    if Found then
    begin
      for i := Low(ObjectArray) to High(ObjectArray) do
      begin
        LMethod.Invoke(Instance, [ObjectArray[i]]);
      end;
    end
    else
    begin
      raise Exception.CreateFmt(StrMethodSNotFound, [AddMethodName]);
    end;
  end;
end;
like image 22
norgepaul Avatar answered Mar 28 '23 15:03

norgepaul