如何链接“并行”类层次结构?

2024-01-23

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

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.

感谢 Cesar、Gamecat 和 mghie。


如果您使用虚拟构造函数创建一个类并为该类创建一个类类型。您可以根据组件类名称创建查找列表。

Example:

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

对mcghie的言论进行评论。

你是完全正确的。但这不可能没有真正丑陋的伎俩。 现在,您必须使用单元的初始化/终结部分来注册类。但是向类添加初始化/终结类方法会很酷。这些必须与单元的初始化(和终结)一起调用。像这样:

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;
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如何链接“并行”类层次结构? 的相关文章

  • 条件表达式在包内是否被破坏?

    考虑以下片段 requires designide rtl vcl IF RTLVersion lt 19 0 E2026 Constant expression expected IF CompilerVersion 22 0 same
  • delphi分组框标题颜色变化

    我正在使用 BDS 2006 想知道您是否可以使用项目中存在的 XPmanifest 更改组框和单选按钮组标题的颜色 因为它始终是蓝色 唯一的方法是重写 Paint 方法TGroupBox http docwiki embarcadero
  • 为应用程序启用主题

    我有一个旧的应用程序 在Win XP中的delphi 7中启动 现在我正在使用delphi 2009 win Vista 如果我开始一个新项目 所有按钮都有一个圆形边缘 但在我的旧应用程序中 所有按钮都有 方形 形状的外观 有什么设置我错过
  • 获取字符、整数和日期字段的字段 oldValue 和 newValue

    我试图只保留表更改的历史记录 所以我想获取一个字段在更改为oldValue之前的值 然后获取它更改为newValue的值 两个值都应转换为字符串 因此 这是该表的一个示例 PartNumber Description 12345 Test
  • Delphi - 相当于C#的三元运算符? [复制]

    这个问题在这里已经有答案了 可能的重复 Delphi 中是否存在或者将来是否存在条件运算符 https stackoverflow com questions 2108609 is there or is there ever going
  • Delphi - 将物理路径(设备文件句柄)转换为虚拟路径

    我怎样才能转换像这样的路径 设备 HarddiskVolume3 Windows 进入其相应的虚拟路径 如本例中的 c Windows 我个人更喜欢原生方式 function GetHDDDevicesWithDOSPath TString
  • 将记录转换为序列化表单数据以通过 HTTP 发送

    有没有办法转换此记录 TError record code Word message String end TState record caption String address Cardinal counters TArray
  • Delphi如何使用其他窗体中的类型?

    抱歉 这是一个非常新手的问题 我正在对这个庞大的应用程序进行维护 它有5种不同的形式 我们将全局变量放在一个单元 uGlobal 中 但我似乎无法从数据单元 uData 访问它 我有这个 Unit uGlobal type TmyType
  • Delphi XE2 Firemonkey 示例应用程序未在 MAC 上运行

    我正在尝试在 Mac 上运行示例 Firemonkey 应用程序 但我在 Mac 中收到以下消息 dyld Library not loaded rpath libcgunwind 1 0 dylib Referenced from Use
  • 如何将 JSON 字符串转换为图像?

    我有一个将图像转换为 JSON 数组的应用程序 并将其保存到 blob 字段中 function getImage String var memorystream TMemoryStream jsonArray TJSONArray beg
  • 如何读取注册表项的默认值

    我有一个 Delphi XE2 项目来使用注册表项进行某些操作 所以我定义了以下代码 procedure TMainForm BitBtn01Click Sender TObject var RegistryEntry TRegistry
  • 从delphi应用程序调用.net4.0 com服务器后出现错误异常

    我们正在将代码库从 BDS2006 迁移到 Rad Studio XE 我们发现了一些非常奇怪的行为 如果我们在从 Net4 0 中实现的 COM 服务器创建一些对象后进行无效的浮点运算 即除以零 我们不会没有得到正常异常 即 EDivis
  • 检测反射 DLL 注入

    在过去的几年中 恶意软件 以及一些渗透测试工具 如 Metasploit 的 meterpreter 负载 已经开始使用反射 DLL 注入 PDF http www harmonysecurity com files HS P005 Ref
  • 以 png 格式剪辑幻灯片 (Delphi 2010)

    I have a filmstrip of images in png format like this 我想知道如何剪辑每个图像并将这些图像放入 TImageList 控件中 并始终保留透明度 EDIT 是的 在设计时 RRUZ 提到的技
  • 如何将数据库查询的行转换为 XML 文件?

    我正在开发一个 Delphi 应用程序 该应用程序需要从一段工作中获取行并将其转换为单个 XML 文件 以便上传到第三方 Web 服务 有没有可用的组件或库可以做到这一点 如果不是 那么构建 DB2XML 转换器的最佳代码方法是什么 我注意
  • 如何从 Delphi 中的函数返回对象而不导致访问冲突?

    我有一个返回 TStringList 的 delphi 函数 但是当我返回一个值并尝试使用它时 我收到一个访问冲突错误 即 myStringList FuncStringList myStringList Items Count lt Th
  • 如何在Delphi中显示Vista风格的气球提示?

    在输入验证时 我使用气球提示而不是消息框 我的问题是 在 Vista 上 它们具有带圆角的旧 XP 样式 而不是较新的矩形外观 我尝试使用 CreateWindowEx 创建它们并且tooltips class32或使用 SendMessa
  • 从 Delphi VCL 样式获取特定字形

    我想从 VCL 样式获取特定的位图 并将其设置为按钮上的图像 它实际上是帮助问号 在位图样式编辑器中是来自表单的 btnHelp 图像 要从 VCL 样式获取视觉元素 字形 您必须使用GetElementDetails和TCustomSty
  • 将图像加载到 TImageList 并读取它们?

    我试图通过将 jpg 转换为 bmp 然后将其保存到 imagelist1 来将 jpg 加载到图像列表中 从上到下的代码片段 Selectdir 有效 fileexists 部分有效 这用于加载文件夹中的所有图像 所有图像都以 0 jpg
  • 如何破解虚拟表?

    我想知道如何更改地址Test它在虚拟表中HackedVTable void HackedVtable cout lt lt Hacked V Table lt lt endl class Base public virtual Test c

随机推荐

  • 如何在散景中显示补丁的图例项

    在以下设置中 我根据基本示例创建面积图 如何自动甚至以编程方式获取输入的图例 现在我只得到带有一个项目 a 和第一种颜色的图例 from bokeh plotting import patches x2 for a in areas lis
  • 四舍五入两位小数

    double x 9 29 double y 8 69 double diff floor x y 100 0 5 100 0 这给了我 diff 为 0 6 但我需要它为 0 60 两位小数 有人可以帮我解决这个问题吗 double 的值
  • .htaccess 将所有子文件夹内容(带或不带结尾斜杠)重定向到同一子文件夹

    我想重定向以下网址 gallery image 1 gallery image 1 gallery image 2 gallery image 2 to gallery 但这比乍看起来要困难 这是来自 htaccess RewriteEng
  • Django,按日期范围内指定的月份和年份进行过滤

    我有以下型号 class Destination Deal models Model name models CharField Nombre max length 200 class Departure Date models Model
  • Javascript 事件似乎没有添加到动态生成的文本框中

    我为 JavaScript 中动态添加的文本框添加了 onkeyup javascript 但它似乎不起作用 var cell4 row insertCell 3 cell4 setAttribute align center var e3
  • JPEG 解压缩在 Windows 体系结构中不一致

    我正在使用不同版本的 Windows 的一堆计算机上测试 JPEG 解压缩 所有这些计算机都安装了 NET 4 我正在针对 NET 2 和 任何 CPU 平台目标进行编译 以下代码在不同的系统上产生不同的输出 Bitmap bmp Bitm
  • 优化“rootn(x, n)”的低精度近似

    rootn float t x int t n is a function that computes the n th root x1 n and is supported by some programming languages su
  • Windows 批处理:从文本文件设置变量

    我目前正在寻找一种通过 txt 文档中的链接在 Windows 批处理文件中设置变量的方法 例如 如果文本文件读取为 http website1 com http website2 com http website3 com 我希望可以将它
  • PHP-EWS“Soap 客户端返回状态 404”

    所以 我正在使用php ews http jamesarmes com php ews库连接到我的 Microsoft Office 365 Exchange 电子邮件帐户以阅读电子邮件 我已成功连接到它 并设法检索我需要的电子邮件列表 现
  • 可以拆分PHP配置文件php.ini吗?

    任何使用 php 的人都知道 php ini 是一个大文件 当您需要更改 ssh 时可能会让人头疼 例如我可以使用更改 nginx confinclude指令将启用站点的目录下的所有文件加载到主 nginx conf 中 所以我的问题很简单
  • 如何计算字符串的 CRC32

    如何计算 NET 中字符串的 CRC32 循环冗余校验和 这家伙似乎已经给你答案了 https damieng com blog 2006 08 08 calculate crc32 in c and net https damieng c
  • MVVM 中的数据绑定 ObservableCollection

    我有一个带有数据模板的 ListView 其中包含电影列表 它被数据绑定到 ObservableCollection 但每当我编辑 Movie Name 时 即使在我的 PropertyChangedEventHandler 中使用 Nam
  • 在 SSLContext 中使用硬件支持的密钥

    我想在 Android 上使用硬件支持的密钥进行客户端双向 TLS 钥匙应该通过生物识别技术解锁 我找到了如何在 Android 上生成硬件支持的密钥对 KeyPairGenerator keyGenerator KeyPairGenera
  • 如何调整 meSpeak.js 以获得更好的声音?

    我是新来的meSpeak js http www masswerk at mespeak 我不能接受他们在演示中的默认声音 我尝试使用他们拥有的选项 但这并没有多大区别 我想知道如何调整它 以使声音接近 Siri 的水平 而不是像他们的演示
  • 如何在vue中创建警报确认框

    我想在删除文件之前显示一个对话框 我如何用vue做到这一点 这是我尝试的 我的删除文件按钮 a href Delete a 这是我的删除方法 DeleteUser id index axios delete api artist id th
  • 无法实例化片段确保类名存在

    android app Fragment InstantiationException 无法实例化 片段 确保类名存在 是公共的并且有一个空 构造函数是公共的 我意识到有很多关于同一错误的问题 但到目前为止没有一个对我有帮助 我正在从一本书
  • 将 Mercurial 与 Cygwin 一起使用?

    我们一直在尝试将 Mercurial 与 Cygwin 在 Windows 上 一起使用 但遇到错误 因为 Cygwin 使用正斜杠 而 Mercurial 似乎需要反斜杠 有解决方法吗 问题示例 hg status M src myfil
  • 自动运行可移动驱动器

    自动运行在 Windows 中被禁用 我正在寻找替代方案 我得到了这个 AutoIt 脚本 DBT DEVICEARRIVAL 0x00008000 WM DEVICECHANGE 0x0219 GUICreate GUIRegisterM
  • Knockout.js 模板未更新 dependentObservable 上的 UI 绑定

    该应用程序是在 vs2010 中使用 ASP NET MVC 3 编写的 我有一个淘汰赛模板 它使用 a 更新一些 css 和可见绑定 依赖的可观察的 仅当我绑定时才会出现此问题 选择元素的值 间隔ID 如果这没有被绑定 UI 按预期更新
  • 如何链接“并行”类层次结构?

    我有一个小的类层次结构 其中每个类对应于某个 TComponent 后代 例如基类 TDefaultFrobber 及其后代 TActionFrobber 和 TMenuItemFrobber 分别对应于 TComponent TCusto