• Using Generic containers in Delphi XE always?


    This was prompted by Deltic's answer, I wanted to provide an counter-example proving you can use generics for the animal feeding routine. (ie: Polymorphic Generic List)

    First some background: The reason you can feed generic animals using a generic base list class is because you'll usually have this kind of inheritance:

    TBaseList = class
      // Some code to actually make this a list
    end
    
    TSpecificList = class(TBaseList)
      // Code that reintroduces the Add and GetItem routines to turn TSpecificList
      // into a type-safe list of a different type, compatible with the TBaseList
    end
    

    This doesn't work with generics because you'll normally have this:

    TDogList = TList<TDog>
    end
    
    TCatList = TList<TCat>
    end
    

    ... and the only "common ancestor" for both lists is TObject - not at all helpful. But we can define a new generic list type that takes two class arguments: a TAnimal and a TSpecificAnimal, generating a type-safe list of TSpecificAnimal compatible with a generic list of TAnimal. Here's the basic type definition:

    TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
    private
      function GetItem(i: Integer): T2;
    public
      procedure Add(A:T2);
      property Item[i:Integer]:T2 read GetItem;default;
    end;
    

    Using this we can do:

    TAnimal = class; 
    TDog = class(TAnimal); 
    TCat = class(TAnimal);
    
    TDogList = TCompatibleList<TAnimal, TDog>;
    TCatList = TCompatibleList<TAnimal, TCat>;
    

    This way both TDogList and TCatList actually inherit from TObjectList<TAnimal>, so we now have a polymorphic generic list!

    Here's a complete Console application that shows this concept in action. And that class is now going into my ClassLibrary for future reuse!

    program Project23;
    
    {$APPTYPE CONSOLE}
    
    uses
      SysUtils, Generics.Collections;
    
    type
    
      TAnimal = class
      end;
    
      TDog = class(TAnimal)
      end;
    
      TCat = class(TAnimal)
      end;
    
      TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
      private
        function GetItem(i: Integer): T2;
      public
        procedure Add(A:T2);
        property Item[i:Integer]:T2 read GetItem;default;
      end;
    
    { TX<T1, T2> }
    
    procedure TCompatibleList<T1, T2>.Add(A: T2);
    begin
      inherited Add(T1(TObject(A)));
    end;
    
    function TCompatibleList<T1, T2>.GetItem(i: Integer): T2;
    begin
      Result := T2(TObject(inherited Items[i]));
    end;
    
    procedure FeedTheAnimals(L: TObjectList<TAnimal>);
    var A: TAnimal;
    begin
      for A in L do
        Writeln('Feeding a ' + A.ClassName);
    end;
    
    var Dogs: TCompatibleList<TAnimal, TDog>;
        Cats: TCompatibleList<TAnimal, TCat>;
        Mixed: TObjectList<TAnimal>;
    
    begin
      try
        // Feed some dogs
        Dogs := TCompatibleList<TAnimal, TDog>.Create;
        try
          Dogs.Add(TDog.Create);
          FeedTheAnimals(Dogs);
        finally Dogs.Free;
        end;
        // Feed some cats
        Cats := TCompatibleList<TAnimal, TCat>.Create;
        try
          Cats.Add(TCat.Create);
          FeedTheAnimals(Cats);
        finally Cats.Free;
        end;
        // Feed a mixed lot
        Mixed := TObjectList<TAnimal>.Create;
        try
          Mixed.Add(TDog.Create);
          Mixed.Add(TCat.Create);
          FeedTheAnimals(Mixed);
        finally Mixed.Free;
        end;
        Readln;
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
    end.
    
  • 相关阅读:
    【PowerOJ1756&网络流24题】最长k可重区间集问题(费用流)
    C/C++运算符进阶
    HTTPS与SSL入门
    UML入门
    valgrind使用入门
    HTML5 Canvas入门
    C++11新特性之智能指针
    使用CppUnit进行单元测试
    邮件系统相关协议之POP
    DNS基本概念和相关命令
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/1993129.html
Copyright © 2020-2023  润新知