创建具有命名子组件的组件?

2024-03-27

我需要了解使组件生成和管理子组件背后的基础知识。我最初通过创建一个来尝试这个TCollection,并尝试为每个人命名TCollectionItem。但我知道这并不像我希望的那么容易。

所以现在我要再次从头开始这个项目,我想这次能做对。这些子组件不是可视组件,不应该有任何显示或窗口,只是基于TComponent。包含这些子组件的主要组件也将基于TComponent。所以这里没有任何东西是可视的,我不想在我的表单上(在设计时)为每个子组件添加一个小图标。

我希望能够以类似集合的方式维护和管理这些子组件。重要的是,应该创建、命名这些子组件并将其添加到表单源中,就像菜单项一样。这就是这个想法的全部要点,如果它们不能被命名,那么整个想法就失效了。

哦,另一件重要的事情:作为所有子组件的父组件的主组件需要能够将这些子组件保存到 DFM 文件中。

EXAMPLE:

而不是访问这些子项目之一,例如:

MyForm.MyItems[1].DoSomething();

我想做一些类似的事情:

MyForm.MyItem2.DoSomething();

所以我不必依赖于知道每个子项的 ID。

EDIT:

我觉得有必要包含我的原始代码,以便可以看到原始集合是如何工作的。这只是从完整单元中剥离的服务器端集合和集合项:

//  Command Collections
//  Goal: Allow entering pre-set commands with unique Name and ID
//  Each command has its own event which is triggered when command is received
//  TODO: Name each collection item as a named component in owner form

  //Determines how commands are displayed in collection editor in design-time
  TJDCmdDisplay = (cdName, cdID, cdCaption, cdIDName, cdIDCaption);

  TJDScktSvrCmdEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
    const Data: TStrings) of object;

  TSvrCommands = class(TCollection)
  private
    fOwner: TPersistent;
    fOnUnknownCommand: TJDScktSvrCmdEvent;
    fDisplay: TJDCmdDisplay;
    function GetItem(Index: Integer): TSvrCommand;
    procedure SetItem(Index: Integer; Value: TSvrCommand);
    procedure SetDisplay(const Value: TJDCmdDisplay);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy;
    procedure DoCommand(const Socket: TJDServerClientSocket;
      const Cmd: Integer; const Data: TStrings);
    function Add: TSvrCommand;
    property Items[Index: Integer]: TSvrCommand read GetItem write SetItem;
  published
    property Display: TJDCmdDisplay read fDisplay write SetDisplay;
    property OnUnknownCommand: TJDScktSvrCmdEvent
      read fOnUnknownCommand write fOnUnknownCommand;
  end;

  TSvrCommand = class(TCollectionItem)
  private
    fID: Integer;
    fOnCommand: TJDScktSvrCmdEvent;
    fName: String;
    fParamCount: Integer;
    fCollection: TSvrCommands;
    fCaption: String;
    procedure SetID(Value: Integer);
    procedure SetName(Value: String);
    procedure SetCaption(const Value: String);
  protected
    function GetDisplayName: String; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property ID: Integer read fID write SetID;
    property Name: String read fName write SetName;
    property Caption: String read fCaption write SetCaption;
    property ParamCount: Integer read fParamCount write fParamCount;
    property OnCommand: TJDScktSvrCmdEvent read fOnCommand write fOnCommand;
  end;

////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////

{ TSvrCommands }

function TSvrCommands.Add: TSvrCommand;
begin
  Result:= inherited Add as TSvrCommand;
end;

constructor TSvrCommands.Create(AOwner: TPersistent);
begin
  inherited Create(TSvrCommand);
  Self.fOwner:= AOwner;
end;

destructor TSvrCommands.Destroy;
begin
  inherited Destroy;
end;

procedure TSvrCommands.DoCommand(const Socket: TJDServerClientSocket;
  const Cmd: Integer; const Data: TStrings);
var
  X: Integer;
  C: TSvrCommand;
  F: Bool;
begin
  F:= False;
  for X:= 0 to Self.Count - 1 do begin
    C:= GetItem(X);
    if C.ID = Cmd then begin
      F:= True;
      try
        if assigned(C.fOnCommand) then
          C.fOnCommand(Self, Socket, Data);
      except
        on e: exception do begin
          raise Exception.Create(
            'Failed to execute command '+IntToStr(Cmd)+': '+#10+e.Message);
        end;
      end;
      Break;
    end;
  end;
  if not F then begin
    //Command not found

  end;
end;

function TSvrCommands.GetItem(Index: Integer): TSvrCommand;
begin
  Result:= TSvrCommand(inherited GetItem(Index));
end;

function TSvrCommands.GetOwner: TPersistent;
begin
  Result:= fOwner;
end;

procedure TSvrCommands.SetDisplay(const Value: TJDCmdDisplay);
begin
  fDisplay := Value;
end;

procedure TSvrCommands.SetItem(Index: Integer; Value: TSvrCommand);
begin
  inherited SetItem(Index, Value);
end;

{ TSvrCommand }

procedure TSvrCommand.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TSvrCommand.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  fCollection:= TSvrCommands(Collection);
end;

destructor TSvrCommand.Destroy;
begin
  inherited Destroy;
end;

function TSvrCommand.GetDisplayName: String;
begin        
  case Self.fCollection.fDisplay of
    cdName: begin
      Result:= fName;
    end;
    cdID: begin
      Result:= '['+IntToStr(fID)+']';
    end;
    cdCaption: begin
      Result:= fCaption;
    end;
    cdIDName: begin
      Result:= '['+IntToStr(fID)+'] '+fName;
    end;
    cdIDCaption: begin
      Result:= '['+IntToStr(fID)+'] '+fCaption;
    end;
  end;
end;

procedure TSvrCommand.SetCaption(const Value: String);
begin
  fCaption := Value;
end;

procedure TSvrCommand.SetID(Value: Integer);
begin
  fID:= Value;
end;

procedure TSvrCommand.SetName(Value: String);
begin
  fName:= Value;
end;

这个话题 https://forums.embarcadero.com/thread.jspa?threadID=63732正如我们昨天讨论的那样,帮助我创造了一些东西。我拿了那里发布的包并对其进行了一些修改。这是来源:

测试组件.pas

unit TestComponents;

interface

uses
  Classes;

type
  TParentComponent = class;

  TChildComponent = class(TComponent)
  private
    FParent: TParentComponent;
    procedure SetParent(const Value: TParentComponent);
  protected
    procedure SetParentComponent(AParent: TComponent); override;
  public
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    property Parent: TParentComponent read FParent write SetParent;
  end;

  TParentComponent = class(TComponent)
  private
    FChilds: TList;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Childs: TList read FChilds;
  end;

implementation

{ TChildComponent }

destructor TChildComponent.Destroy;
begin
  Parent := nil;
  inherited;
end;

function TChildComponent.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

function TChildComponent.HasParent: Boolean;
begin
  Result := Assigned(FParent);
end;

procedure TChildComponent.SetParent(const Value: TParentComponent);
begin
  if FParent <> Value then
  begin
    if Assigned(FParent) then
      FParent.FChilds.Remove(Self);
    FParent := Value;
    if Assigned(FParent) then
      FParent.FChilds.Add(Self);
  end;
end;

procedure TChildComponent.SetParentComponent(AParent: TComponent);
begin
  if AParent is TParentComponent then
    SetParent(AParent as TParentComponent);
end;

{ TParentComponent }

constructor TParentComponent.Create(AOwner: TComponent);
begin
  inherited;
  FChilds := TList.Create;
end;

destructor TParentComponent.Destroy;
var
  I: Integer;
begin
  for I := 0 to FChilds.Count - 1 do
    FChilds[0].Free;
  FChilds.Free;
  inherited;
end;

procedure TParentComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i: Integer;
begin
  for i := 0 to FChilds.Count - 1 do
    Proc(TComponent(FChilds[i]));
end;

end.

测试组件Reg.pas

unit TestComponentsReg;

interface

uses
  Classes,
  DesignEditors,
  DesignIntf,
  TestComponents;

type
  TParentComponentEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses
  ColnEdit;

type
  TChildComponentCollectionItem = class(TCollectionItem)
  private
    FChildComponent: TChildComponent;
    function GetName: string;
    procedure SetName(const Value: string);
  protected
    property ChildComponent: TChildComponent read FChildComponent write FChildComponent;
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Name: string read GetName write SetName;
  end;

  TChildComponentCollection = class(TOwnedCollection)
  private
    FDesigner: IDesigner;
  public
    property Designer: IDesigner read FDesigner write FDesigner;
  end;

procedure Register;
begin
  RegisterClass(TChildComponent);
  RegisterNoIcon([TChildComponent]);
  RegisterComponents('Test', [TParentComponent]);
  RegisterComponentEditor(TParentComponent, TParentComponentEditor);
end;

{ TParentComponentEditor }

procedure TParentComponentEditor.ExecuteVerb(Index: Integer);
var
  LCollection: TChildComponentCollection;
  i: Integer;
begin
  LCollection := TChildComponentCollection.Create(Component, TChildComponentCollectionItem);
  LCollection.Designer := Designer;
  for i := 0 to TParentComponent(Component).Childs.Count - 1 do
    with TChildComponentCollectionItem.Create(nil) do
    begin
      ChildComponent := TChildComponent(TParentComponent(Component).Childs[i]);
      Collection := LCollection;
    end;
  ShowCollectionEditorClass(Designer, TCollectionEditor, Component, LCollection, 'Childs');
end;

function TParentComponentEditor.GetVerb(Index: Integer): string;
begin
  Result := 'Edit Childs...';
end;

function TParentComponentEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TChildComponentCollectionItem }

constructor TChildComponentCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  if Assigned(Collection) then
  begin
    FChildComponent := TChildComponent.Create(TComponent(TOwnedCollection(Collection).Owner).Owner);
    FChildComponent.Name := TChildComponentCollection(Collection).Designer.UniqueName(TChildComponent.ClassName);
    FChildComponent.Parent := TParentComponent(TComponent(TOwnedCollection(Collection).Owner));
  end;
end;

destructor TChildComponentCollectionItem.Destroy;
begin
  FChildComponent.Free;
  inherited;
end;

function TChildComponentCollectionItem.GetDisplayName: string;
begin
  Result := FChildComponent.Name;
end;

function TChildComponentCollectionItem.GetName: string;
begin
  Result := FChildComponent.Name;
end;

procedure TChildComponentCollectionItem.SetName(const Value: string);
begin
  FChildComponent.Name := Value;
end;

end.

最重要的是 RegisterNoIcon,它可以防止在创建组件时在表单上显示该组件。 TChildComponent 中的重写方法导致它们嵌套在 TParentComponent 内。

编辑:我添加了一个临时集合来编辑内置 TCollectionEditor 中的项目,而不必编写自己的集合。唯一的缺点是 TChildComponentCollectionItem 必须发布 TChildComponent 已发布的每个属性,以便能够在 OI 内编辑它们。

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

创建具有命名子组件的组件? 的相关文章

  • 在自定义 Flex 组件中绘制叠加层

    如何在 Flex 中创建一个自定义 MXML 组件 该组件基于现有组件 但在某些情况下会在该现有组件上绘制覆盖层 理想情况下 新组件应该基于 派生自 现有组件 以便现有组件的出现可以用新组件替换 我尝试在新组件中重写 updateDispl
  • 读写文本文件的最佳方法

    我正在使用最新版本的 Lazarus IDE 并且我有一个Memo1在我的 TForm1 上 我必须加载一个文本文件Memo1然后编辑备忘录的每一行 我使用Memo1 Lines Strings i 最后 我必须将编辑后的备忘录保存在特定路
  • NvCplGetThermalSettings 返回 false

    问题 您好 我正在尝试使用 Delphi 获取 nividia gtx 980 的 GPU 温度 我看过C 问题 他的解决方案是不使用nvcpl dll 我认为这不是正确的解决方案 因为 nivida 有完整的文档说明如何处理 API 见下
  • 如何在 Delphi 中更改 TabControl 中活动 TAB 的颜色

    如何更改 TabControl 在 FireMonkey 上 中活动 TAB 的颜色 如下所示 有两种方法可以实现这一点 1 第一个选项是您可以创建定制风格 for 选项卡控件 from T样本 风格设计师 然后您可以添加您想要在自定义设计
  • 检测 TWebBrowser 文档中的活动元素何时发生变化

    是否有任何我可以挂钩的事件来检测网页上的活动元素何时发生变化 例如 当用户聚焦编辑框时 我知道我可以检查计时器中的活动元素 但如果可能的话我宁愿避免这种情况 这并不是对您的问题的完整答案 但希望能帮助您完成大部分工作 对于通过类似的 q 到
  • 在设计时存储“记录数组”的最佳方式

    我需要在设计时存储一组数据 以便在运行时构造一组组件的内容 像这样的事情 type TVulnerabilityData record Vulnerability TVulnerability Name string Description
  • 开发 Delphi Windows 7 应用程序的规则 [关闭]

    Closed 这个问题不符合堆栈溢出指南 help closed questions 目前不接受答案 在哪里可以找到开发适用于 Windows 7 的 Delphi 应用程序时应遵循的最佳规则集 Marco 最近发表了 2 篇关于此主题的帖
  • 对 smtp.live.com 和 TIdSmtp(Indy、Delphi)的 SSL 支持

    我正在尝试连接到 smtp live com 发送电子邮件 live com 自 2009 年以来显然支持免费的 pop3 smtp 但这对我来说完全是新闻 当我尝试连接到 smtp live com 端口 587 时 会发生以下情况 Me
  • ClientDataset 索引更改时不计算 TAggregateField

    我正在使用连接到 DBGrid 的 TClientDataset 和几个聚合字段 用于计算其他几个浮点字段的总和 所有字段均已在设计时创建 一切都按预期工作 直到 ClientDataset 的 IndexName 使用自定义索引更改 以便
  • TWebbrowser 大量内存泄漏:到目前为止还没有解决方案

    我有一个使用的应用程序TWebbrowser定期导航到特定 URL 并提取一些数据 该应用程序 24x7 持续运行 并在页面中进行大量导航 问题是TWebbrowser有一个众所周知的内存泄漏问题 每次导航到新页面时 应用程序使用的内存都会
  • 可以在delphi数据集中创建一个假数据字段吗?

    我想在 DataSet 不是 ClientDataSet 中创建一个 假 数据字段 该字段不应存储在数据库中 它不是计算字段 应允许用户输入输入数据 该字段具有业务逻辑含义 因此用户更新其值后应该更新其他字段 使用 OnFieldChang
  • 线程关闭期间 Win64 Delphi RTL 中的内存泄漏?

    很长一段时间以来 我注意到我的服务器应用程序的 Win64 版本存在内存泄漏问题 虽然 Win32 版本工作正常 内存占用相对稳定 但 64 位版本使用的内存却定期增加 可能 20Mb 天 没有任何明显的原因 不用说 FastMM4 没有报
  • 如何仅在某些列中设置带有复选框的 TListView?

    我正在使用 Delphi 2010 并且我试图允许用户在 TListView 中的每行 2 个选项之间进行选择 使用 TListView 我可以将样式设置为 vsReport 并启用复选框 但这只会让我每行有 1 个复选框 我需要的是每行
  • 如何修复 Delphi Prism ASP.NET 错误:“解析器错误消息:‘Oxygene’不是受支持的语言”

    我在 Delphi Prism 中编写了一个 ASP NET Web 应用程序 不是网站 在我的开发机器上一切正常 但是当我将其安装在测试服务器上时 出现以下错误 Server Error in MyApp Application Pars
  • 在主表单之前显示登录表单

    我在表单之间导航时遇到问题 我使用 Delphi XE5 创建了一个 Android Firemonkey 移动应用程序 我目前有一个登录表单和主表单 现在我想要有关如何处理登录表单以显示在主表单之前的建议 在 项目选项 中的表单下 选择要
  • delphi分组框标题颜色变化

    我正在使用 BDS 2006 想知道您是否可以使用项目中存在的 XPmanifest 更改组框和单选按钮组标题的颜色 因为它始终是蓝色 唯一的方法是重写 Paint 方法TGroupBox http docwiki embarcadero
  • 如何使用 jQuery 和“长轮询”通过 Indy HTTP 服务器动态更新 HTML 页面?

    我读过这篇文章使用 JavaScript 和 jQuery 的简单长轮询示例 http techoctave com c7 posts 60 simple long polling example with javascript and j
  • Delphi XE 中的数据绑定向导 - 可以将其配置为映射到 MSXML 接口吗?

    Delphi XE 中的数据绑定向导生成继承自 Delphi 自己的 DOM ADOM XML v4 实现的类和接口 它似乎不支持针对模式进行验证 解析时验证 选项仅适用于 MSXML 供应商type 从 VCL 源代码以及 IDE 中 X
  • Delphi 的免费加密库 [关闭]

    Closed 此问题正在寻求书籍 工具 软件库等的推荐 不满足堆栈溢出指南 help closed questions 目前不接受答案 我正在为 Delphi 2010 寻找一个免费且最新的加密库 该库实现 RSA 和 AES Rijnda
  • 将记录转换为序列化表单数据以通过 HTTP 发送

    有没有办法转换此记录 TError record code Word message String end TState record caption String address Cardinal counters TArray

随机推荐

  • 主机名未使用 Winsock 转换为 IP 地址

    getaddrinfo 不会将主机名转换为 IP 地址 因此不会connect 到服务器 我的实现有问题吗 编译时没有警告消息 这个函数调用的是connect正确的 connect client result gt ai addr resu
  • 在 Python 中编写仅附加 gzip 日志文件

    我正在构建一项服务 在其中记录来自多个源的纯文本格式日志 每个源一个文件 我不打算轮换这些日志 因为它们必须永远存在 为了使这些永远存在的文件更小 我希望我可以在飞行中对它们进行 gzip 压缩 由于它们是日志数据 因此文件压缩得很好 在
  • 当对象包含 ng-repetate 时,如何使用 angularFire 保存 Firebase 对象 $asArray()

    我最近从 angularfire 0 6 切换到 0 8 0 我在保存包含数组本身的列表项时遇到问题 我的对象account看起来像这样 JQruasomekeys0nrXxH created 2014 03 23T22 00 10 176
  • Python 与格式 '%Y-%m-%dT%H:%M:%S%Z.%f' 不匹配

    我尝试在Python中将字符串转换为日期时间对象 但我找不到我的格式有任何问题 Y m dT H M S Z f import datetime datetime datetime strptime 2019 11 19T17 22 23
  • 使用 getFilesDir() 时应用程序上下文返回 null

    我不知道为什么会发生这种情况 当我检查 DDMS 时也没有文件目录 我正在尝试在我的应用程序子类中访问此文件夹 知道为什么会发生这种情况吗 我需要应用程序上下文是全局的 这样我就可以在不扩展 Activity 的类上使用 package m
  • Selenium-Webdriver:找到元素后获取属性

    我对自动化的东西还很陌生 所以这听起来像是一个愚蠢的问题 在发布问题之前 我确实用谷歌搜索了它 不管怎样 问题就在这里 我正在 Android 设备上进行自动化测试 其中一项测试是验证某个项目是否已被标记为 收藏夹 页面代码片段为 li c
  • Android Studio 2.3 错误:无法加载类“com.google.common.collect.ImmutableSet”

    大家 突然 当我打开现有项目时 出现错误 错误 无法加载类 com google common collect ImmutableSet 导致此意外错误的可能原因包括 格拉德尔的 依赖项缓存可能已损坏 这有时会在网络连接后发生 连接超时 重
  • 创建基类对象的向量并在其中存储派生类对象

    我正在尝试创建一个员工数据库 员工向量 有 3 种类型的员工 即 Employees 是基类 Manager Engg 和 Scientist 是派生类 每个员工都有名字和姓氏 除了名字之外 这 3 种类型的员工中的每一种都有独特的统计数据
  • javascript date.utc 问题

    我正在尝试使用 javascript 比较 2 个日期 月末 1 个 月初 1 个 我需要以秒为单位比较这两个日期 因此我使用 Date UTC javascript 函数 这是代码 var d Date UTC 2010 5 31 23
  • 实体框架中推荐的身份生成方法是什么?

    我对 StoreGeneratePattern 的最高效的方式感兴趣 过去我习惯让数据库为我生成ID 但我想知道设置是否有任何优势 StoreGeneratedPattern None 代替 StoreGeneratedPattern Id
  • Demean R 数据框

    我想贬低 R 中的多列data frame 使用来自的示例这个问题 https stats stackexchange com questions 46978 fixed effects using demeaned data why di
  • android maven插件在Eclipse中没有获取ANDROID_HOME环境变量

    我正在开发一个 Android 应用程序项目 它是一个 Maven 项目 当我尝试作为 maven install 运行时 这就是我得到的 无法在项目 android client 上执行目标 com jayway maven plugin
  • 如果给定空白正则表达式,则 regex_replace 中的 C++ Mac OS 无限循环

    执行后 std regex replace the string std regex doesn t matter 我的 Mac 将无限期挂起 我是 xcode 新手 但我认为我正确使用它 我在调试程序时点击 暂停 发现最后执行的代码位于正
  • 无法通过Java删除目录

    在我的应用程序中 我编写了从驱动器中删除目录的代码 但是当我检查文件的删除功能时 它不会删除该文件 我写过一些这样的东西 Code to delete the directory if it exists File directory ne
  • javaFX 表视图中的错误

    I make TableView在 javaFX 中包含两个TableColumns TableView Span 的宽度大于所有的宽度TableColumn 但这不是问题 我不明白的是 当我单击包含数据的行外部区域和列外部区域 红色区域
  • 在哪里可以找到已实施的耐心差异?

    这个网站上有很好的答案 Bram Cohen 的耐心 diff 在 bazaar 中作为默认 diff 和 git diff 的一个选项找到 但我发现很难找到一个独立的独立程序来实现这个特定的 diff 算法 例如 我想将 Patient
  • 根据列表中的值将列添加到数据框

    我有一个如下所示的数据框 df lt data frame A c a b c d e f g h i B c 1 1 1 2 2 2 3 3 3 C c 0 1 0 2 0 4 0 1 0 5 0 7 0 1 0 2 0 5 gt df
  • PHP 发送邮件表单到多个电子邮件地址

    我对 PHP 非常陌生 正在联系页面上使用基本模板 发送邮件 表单 当单击 提交 按钮时 要求我将电子邮件发送到多个电子邮件地址 我已经四处搜寻 但还没有找到我需要的东西 我需要在下面的表单中添加什么代码才能将其发送到多个电子邮件地址
  • Tensorflow.Keras:自定义约束不起作用

    我正在尝试实现权重正交约束所示here https towardsdatascience com build the right autoencoder tune and optimize using pca principles part
  • 创建具有命名子组件的组件?

    我需要了解使组件生成和管理子组件背后的基础知识 我最初通过创建一个来尝试这个TCollection 并尝试为每个人命名TCollectionItem 但我知道这并不像我希望的那么容易 所以现在我要再次从头开始这个项目 我想这次能做对 这些子