Как связать иерархию классов «параллельно»?

Question

У меня есть небольшая иерархия классов, где каждый класс соответствует определенному потомку TComponent (скажем, базовый класс TDefaultFrobber с потомками TActionFrobber и TMenuItemFrobber, соответствующими TComponent, TCustomAction и TMenuItem соответственно). Теперь я хочу завод функция что-то вроде этого (?):

function CreateFrobber(AComponent: TComponent): IFrobber; 
begin 
    if AComponent is TCustomAction then 
    Result := TActionFrobber.Create(TCustomAction(AComponent)) 
    else if AComponent is TMenuItem then 
    Result := TMenuItemFrobber.Create(TMenuItem(AComponent)) 
    else 
    Result := TDefaultFrobber.Create(AComponent); 
end; 

Могу ли я как-то реорганизовать это использовать виртуальные функции или что-то подобное вместо если-то еще каскаде или RTTI?

Edit: Мое решение на данный момент:

unit Frobbers; 

interface 

uses 
    Classes; 

type 
    IComponentFrobber = interface 
    end; 

    TComponentFrobberClass = class of TComponentFrobber; 

    TComponentFrobber = class(TInterfacedObject, IComponentFrobber) 
    strict private 
    FComponent: TComponent; 
    protected 
    constructor Create(AComponent: TComponent); 
    property Component: TComponent read FComponent; 
    public 
    class function FindFrobberClass(AComponentClass: TComponentClass): TComponentFrobberClass; overload; static; 
    class function FindFrobberClass(AComponent: TComponent): TComponentFrobberClass; overload; static; 
    class procedure RegisterFrobber(AComponentClass: TComponentClass; AFrobberClass: TComponentFrobberClass); static; 
    end; 

implementation 

uses 
    ActnList, 
    Menus; 

type 
    TComponentFrobberRegistryItem = record 
    ComponentClass: TComponentClass; 
    FrobberClass: TComponentFrobberClass; 
    end; 

var 
    FComponentFrobberRegistry: array of TComponentFrobberRegistryItem; 

class function TComponentFrobber.FindFrobberClass(AComponentClass: TComponentClass): TComponentFrobberClass; 
var 
    i: Integer; 
begin 
    // Search backwards, so that more specialized frobbers are found first: 
    for i := High(FComponentFrobberRegistry) downto Low(FComponentFrobberRegistry) do 
    if FComponentFrobberRegistry[i].ComponentClass = AComponentClass then 
    begin 
     Result := FComponentFrobberRegistry[i].FrobberClass; 
     Exit; 
    end; 
    Result := nil; 
end; 

constructor TComponentFrobber.Create(AComponent: TComponent); 
begin 
    inherited Create; 
    FComponent := AComponent; 
end; 

class function TComponentFrobber.FindFrobberClass(AComponent: TComponent): TComponentFrobberClass; 
var 
    i: Integer; 
begin 
    // Search backwards, so that more specialized frobbers are found first: 
    for i := High(FComponentFrobberRegistry) downto Low(FComponentFrobberRegistry) do 
    if AComponent is FComponentFrobberRegistry[i].ComponentClass then 
    begin 
     Result := FComponentFrobberRegistry[i].FrobberClass; 
     Exit; 
    end; 
    Result := nil; 
end; 

class procedure TComponentFrobber.RegisterFrobber(AComponentClass: TComponentClass; 
    AFrobberClass: TComponentFrobberClass); 
var 
    i: Integer; 
begin 
    Assert(FindFrobberClass(AComponentClass) = nil, 'Duplicate Frobber class'); 
    i := Length(FComponentFrobberRegistry); 
    SetLength(FComponentFrobberRegistry, Succ(i)); 
    FComponentFrobberRegistry[i].ComponentClass := AComponentClass; 
    FComponentFrobberRegistry[i].FrobberClass := AFrobberClass; 
end; 

function CreateComponentFrobber(AComponent: TComponent): IComponentFrobber; 
var 
    FrobberClass: TComponentFrobberClass; 
begin 
    FrobberClass := TComponentFrobber.FindFrobberClass(AComponent); 
    Assert(FrobberClass <> nil); 
    Result := FrobberClass.Create(AComponent); 
end; 

type 
    TActionFrobber = class(TComponentFrobber); 
    TMenuItemFrobber = class(TComponentFrobber); 

initialization 
    TComponentFrobber.RegisterFrobber(TCustomAction, TActionFrobber); 
    TComponentFrobber.RegisterFrobber(TMenuItem, TMenuItemFrobber); 
end. 

Благодаря Сезар, Gamecat и mghie.

Answer 1

-предложения: Марки пара класса массив классов, то вы можете получить индекс и использовать пару конструктора класса,

var 
    ArrayItem: array[0..1] of TComponentClass = (TActionFrobber, TMenuItemFrobber); 
    ArrayOwner: array[0..1] of TComponentClass = (TCustomAction, TMenuItem); 

function CreateFrobber(AComponent: TComponentClass): IFrobber; 
var 
    Index: Integer; 
begin 
    Result:= nil; 
    for I := Low(ArrayOwner) to High(ArrayOwner) do 
    if AComponent is ArrayOwner[I] then 
    begin 
     Result:= ArrayItem[I].Create(AComponent); 
     Break; 
    end; 

    if Result = nil then 
    Result:= TDefaultFrobber.Create(AComponent); 
end; 

или использовать соглашение RTTI + Classname, как это:

function CreateFrobber(AComponent: TComponentClass): IFrobber; 
const 
    FrobberClassSuffix = 'Frobber'; 
var 
    LClass: TComponentClass; 
    LComponent: TComponent; 
begin 
    LClass:= Classes.FindClass(AComponent.ClassName + FrobberClassSuffix); 
    if LClass <> nil then 
    LComponent:= LClass.Create(AComponent) 
    else 
    LComponent:= TDefaultFrobber.Create(AComponent); 

    if not Supports(LComponent, IFrobber, Result) then 
    Result:= nil; 
end; 

Answer 2

Если вы создаете класс с виртуальным конструктором и создаете тип класса для этого класса. Вы можете создать список поиска, основанный на имени класса компонента.

Пример:

type 
    TFrobber = class 
    public 
    constructor Create; virtual; 

    class function CreateFrobber(const AComponent: TComponent): TFrobber; 
    end; 
    TFrobberClass = class of TFrobber; 

    type 
    TFrobberRec = record 
     ClassName: ShortString; 
     ClassType: TFrobberClass; 
    end; 

    const 
    cFrobberCount = 3; 
    cFrobberList : array[1..cFrobberCount] of TFrobberRec = (
     (ClassName : 'TAction'; ClassType: TActionFrobber), 
     (ClassName : 'TButton'; ClassType: TButtonFrobber), 
     (ClassName : 'TMenuItem'; ClassType: TMenuItemFrobber) 
    ); 

    class function TFrobber.CreateFrobber(const AComponent: TComponent): TFrobber; 
    var 
    i : Integer; 
    begin 
    Result := nil; 
    for i := 1 to cFrobberCount do begin 
     if AComponent.ClassName = cFrobberList[i].ClassName then begin 
     Result := cFrobberList[i].ClassType.Create(); 
     Exit; 
     end; 
    end; 
    end; 

Конечно, Вы можете также работать с динамическим списком (словарь), но тогда вы должны зарегистрировать каждую комбинацию каким-то образом.

Update

Чтобы commnent на замечания mghie.

Вы совершенно правы. Но это не возможно без уродливых трюков. Прямо сейчас вы должны использовать разделы инициализации/окончательной доработки блока для переопределения класса. Но было бы здорово добавить класс класса инициализации/доработки. Они должны быть вызваны вместе с инициализацией (и завершением) блока. Как это:

class 
    TFrobber = class 
    private 
    initialization Init; // Called at program start just after unit initialization 
    finalization Exit; // called at program end just before unit finalization. 
    end; 

Answer 3

Я хотел бы добавить некоторые комментарии к текущему решению, отвечая здесь, так как это не может действительно быть сделано в разделе комментариев:

type 
    IComponentFrobber = interface 
    end; 

    TComponentFrobberClass = class of TComponentFrobber; 

    TComponentFrobber = class(TInterfacedObject, IComponentFrobber) 
    strict private 
    FComponent: TComponent; 
    protected 
    constructor Create(AComponent: TComponent); 
    property Component: TComponent read FComponent; 
    public 
    class function FindFrobberClass(AComponentClass: TComponentClass): 
     TComponentFrobberClass; overload; static; 
    class function FindFrobberClass(AComponent: TComponent): 
     TComponentFrobberClass; overload; static; 
    class procedure RegisterFrobber(AComponentClass: TComponentClass; 
     AFrobberClass: TComponentFrobberClass); static; 
    end; 

Существует не так много смысла в использовании TInterfacedObject для базового класса, так как вы всегда будете нуждаться в объекте, а не его интерфейс реализует - как бы вы еще найти свой конкретный класс Frobber? Я бы разделил это на TComponentFrobber, спустился с TInterfacedObject и класс TComponentRegistry (спуск из TObject), который имеет методы класса. Вы можете, конечно, сделать класс реестра более общим, он не привязан к TComponentFrobber и может быть повторно использован.

Edit: я использовал подобные регистры класса, например при загрузке файлов: загрузите идентификатор следующего объекта (может быть, например, строку, целое число или GUID), а затем получить правильный класс для создания экземпляра из реестра, затем создайте и загрузите объект.

type 
    TComponentFrobberRegistryItem = record 
    ComponentClass: TComponentClass; 
    FrobberClass: TComponentFrobberClass; 
    end; 

var 
    FComponentFrobberRegistry: array of TComponentFrobberRegistryItem; 

Это нормально, если вы никогда не будете добавлять или удалять классы в/из реестра, но в целом я бы не использовать массив, но список для записи реестра.

class function TComponentFrobber.FindFrobberClass(AComponentClass: TComponentClass): 
    TComponentFrobberClass; 
var 
    i: Integer; 
begin 
    // Search backwards, so that more specialized frobbers are found first: 
    for i := High(FComponentFrobberRegistry) downto Low(FComponentFrobberRegistry) do 
    if FComponentFrobberRegistry[i].ComponentClass = AComponentClass then 
    begin 
     Result := FComponentFrobberRegistry[i].FrobberClass; 
     Exit; 
    end; 
    Result := nil; 
end; 

Поиск в обратном направлении в массиве не поможет в поиске наиболее специализированной frobber, если не добавить их в правильном порядке (наименее специализированный первый). Почему бы вам не проверить, является ли ClassType равным? Существует также ClassParent для прохождения иерархии классов, если вам нужно также проверить базовые классы.