「並列」クラス階層をリンクするにはどうすればよいですか?

https://stackoverflow.com/questions/503079

20-08-2019
|

質問

各クラスが特定の TComponent の子孫に対応する小さなクラス階層があります (たとえば、TComponent、TCustomAction、TMenuItem にそれぞれ対応する子孫 TActionFrobber と TMenuItemFrobber を持つ基本クラス TDefaultFrobber など)。ここで、次のようなファクトリー (?) 関数が必要です。

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;

if-else カスケードや RTTI の代わりに仮想関数などを使用するようにこれを何らかの方法でリファクタリングできますか?

編集： 今のところ私の解決策:

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.

Cesar、Gamecat、mghie に感謝します。

解決

2つの提案：クラスのクラスペアの配列を作成し、その後、インデックスを取得し、クラスのコンストラクタのペアを使用することができ、

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 +クラス名の規約を使用します：

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;

他のヒント

仮想コンストラクターを使用してクラスを作成し、そのクラスのクラス型を作成する場合。コンポーネントのクラス名に基づいてルックアップリストを作成できます。

例：

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;

もちろん、動的リスト (辞書) を使用することもできますが、その場合はそれぞれの組み合わせを何らかの方法で登録する必要があります。

アップデート

ムギーの発言についてコメントする。

あなたは完全に正しいです。しかし、これには本当に醜いトリックがないわけではありません。現時点では、クラスを再登録するにはユニットの初期化/終了セクションを使用する必要があります。しかし、初期化/終了クラスメソッドをクラスに追加するのは素晴らしいでしょう。これらは、ユニットの初期化 (および終了) とともに呼び出す必要があります。このような：

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;

私はこれは本当にコメント欄で行うことができないよう、ここで答えて、あなたの現在のソリューションにいくつかのコメントを追加したいと思います：

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;

他にどのようにあなたの具体的なFrobberクラスを見つけるだろう - あなたは常にオブジェクトではなく、それが実装インタフェースが必要になりますように、

基本クラスのTInterfacedObjectはを使用して多くのポイントは、ありませんか？私はTInterfacedObjectはから下降、TComponentFrobberにこれを分割し、クラスメソッドを有する（TObjectをから降順）TComponentRegistryクラスであろう。その後、もちろんそれはTComponentFrobberに縛られず、再利用することができ、より一般的なレジストリのクラスを作ることができます。

の編集：ファイルをロードする場合のIは、例えば、類似したクラスのレジストリを使用している：正しいクラスをインスタンス化するために取得、その後、次のオブジェクト（例えば、文字列、整数またはGUIDのためにすることができる）のための識別子を読み込みますレジストリから、そのオブジェクトを作成し、ロードします。

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

var
  FComponentFrobberRegistry: array of TComponentFrobberRegistryItem;

あなたが追加したり、レジストリから/へのクラスを削除するが、一般的に、私はレジストリエントリの配列が、リストを使用していないだろう決して場合は、

これはOKです。

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 1つされています。

ライセンス： CC-BY-SA と帰属

所属していません StackOverflow