logo标签列表

如何连接“并行”类层次结构？

delphivirtualrtticlass-hierarchy
4

我有一个小的类层次结构，其中每个类对应于某个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;

我可以通过使用虚函数或类似的东西来重构这个代码，而不是使用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的贡献。
添加了一个带有注释的答案，因为它们永远不会适合这里；-) - mghie
3个回答
3
如果您创建了一个带有虚构造函数的类，并为该类创建了一个类类型。您可以基于组件类名称创建查找列表。
示例：
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;

当然，您也可以使用动态列表（字典）来工作，但是需要以某种方式注册每个组合。

更新

针对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;
对这个想法表示赞同，但是一定要选择动态注册标准类和匹配的 Frobber 类。这样可以让所有东西之间的耦合更松散。类注册表不需要知道所有具体类，就像答案中的代码所需的那样。 - mghie
我真的在寻找一种更“编译时安全”的方法，但我想RegisterClass类型是我能得到的最接近的。也许可以像Cesar建议的那样使用TComponentClass而不是类名。 - Uli Gerhardt
@Gamecat：关于你的编辑 - 我不认为在初始化子句中注册的需要是一个真正的问题。如果不想要这样做，当然也可以手动注册Frobber类。这也打开了运行时更改可用Frobber类的大门。类初始化看起来很不错！ - mghie
但是任何组件应该如何匹配组件类？你能否澄清一下？ - mghie
@mghie，关于match：我猜Gamecat是指TComponent的测试与任何组件匹配，因此在RegisterFrobber调用的顺序上必须小心。我猜向后搜索frobber注册表应该可以解决问题。 - Uli Gerhardt
显示剩余4条评论
2

两个建议： 1. 创建一个类对数组，然后您可以获取索引并使用类构造函数的对 2. 保留HTML标签

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;
在我看来，RTTI + ClassName 的约定想法太脆弱了，为什么要把自己限制在这样的角落里呢？ - mghie
我同意，并且更喜欢使用 class pair 数组。我只是提出另一个选项。他可以选择使用或不使用，但至少他知道可以用这种方式实现。 - Cesar Romero
1

我想对你目前的解决方案添加一些评论，因为在评论部分无法真正完成此操作：

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绑定，可以重复使用。

编辑：例如，在加载文件时，我使用类似的类注册表：加载下一个对象的标识符（例如字符串、整数或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 遍历类层次结构。
IComponentFrobber接口纯粹用于生命周期管理 - 使用frobbers时不需要try/finally。我想我可以使用一些IObjectSafe实现代替。 - Uli Gerhardt
关于数组：使用数组更加简单 - 无需释放，无需派生一个可以容纳指针对的容器类。从注册表中删除不会发生 - 目前只有在初始化部分中调用 RegisterFrobber 函数。 - Uli Gerhardt
好的。并不是说你应该改变你的代码，也许它会在某个时候帮助到其他人，毕竟StackOverflow旨在成为类似维基百科的平台。 - mghie
我没有那样理解。我只是欣赏你的评论。 - Uli Gerhardt
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接