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

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(使用前将#替换为@)

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

  • Delphi 如何与 Active Directory 集成?

    我们需要使用 Delphi 7 验证 Microsoft Active Directory 上的用户 最好的方法是什么 我们可以有两种情况 用户输入其网络用户名和密码 其中用户名可能包括域 然后我们检查活动目录是否是有效的活动用户 或者我们
  • 创建FileStream时如何处理异常

    我有一个这样的函数 我想重构它 function Myfunction sUrl sFile String Boolean var GetData TFileStream begin Result False if the line bel
  • Delphi错误数据集未处于插入或编辑模式

    客观的 单击 TRxDBCombo 上的按钮调用搜索框 从搜索框中选择记录时 结果将设置为 TComboEditBox 的字段值 并发布在 TRxMemoryData 数据集中 错误 第二次调用此函数时出现数据集未处于插入或编辑模式 TDB
  • ComboBox.Sorted 发生了什么:= True;在德尔福 10.2 中?

    最近我的最后一个问题获得了 风滚草 徽章 我不确定是否应该问更多问题 但这里是 我正在填充一个TComboBox使用 sqlite 表中的项目 效果很好 在我以前的 Delphi 版本中 我能够使用ComboBox1 Sorted True
  • Delphi 7,加载PNG到TImage

    只是想加载 PNG 尝试使用适用于其他格式的 OleGraphic 来使用我的 LoadPic 但在 PNG 上失败 目标是将图像复制到隐藏位图 然后将其屏蔽并复制到可见的工作图像画布 如果 CopyRect 不这样做 请随意提出其他建议
  • 使用普通画布/文本输出更新LayeredWindow

    有没有一种方法可以使用画布在表单上绘图 然后使用 updatelayeredwindow 这样表单就不可见 但文本可见 就像只显示文本的半透明表单一样 如果没有 那么有没有办法只用画布 opengl directx 制作某种半透明形式 我想
  • 获取 TransactSql 批处理中的语句数计数

    对于不使用 Delphi 的读者 虽然以下内容是根据 Delphi 编码来表达的 但我的实际技术问题不是特定于 Delphi 的 而是关于如何找出 Sql Server 如何 理解 TransactSql 批处理提交给它 TAdoQuery
  • delphi 变量值在循环中的线程中发生变化

    我的代码正在运行一个 for 循环来处理一些数据 如下所示 procedure printValue Value Integer begin TThread Synchronize TThread Current procedure beg
  • 如何避免使用 WinApi.Windows 的 Delphi 应用程序中的 dll 劫持

    Delphi 最新版本使用各种系统 dll 的静态链接 例如 WinApi Windows 单元中的 version dll 这会导致在单元初始化之前加载 version dll 这会打开一个安全漏洞 可以通过将受感染的 version d
  • 如何在滚动框上创建缓慢的滚动效果?

    我喜欢在滚动框中平移图像后创建平滑的减慢滚动效果 就像平移地图一样谷歌地图 http maps google com 我不确定它是什么类型 但行为完全相同 当快速移动地图时 当您释放鼠标时它不会立即停止 而是开始减慢速度 有什么想法 组件
  • 如何遍历任意给定集合中的枚举?

    我有很多枚举类型 它们与相应的集合相结合 例如 type TMyEnum meOne meTwo meThree TMyEnums set of TMyEnum 我正在尝试提出一组可以运行的函数any枚举集 而不是为每个枚举编写单独的函数
  • TDictionary 上的 GetItem 由链接器消除

    我正在使用一个TDictionary of
  • 如何在调试器中显示 TStringList 的内容?

    我想在调试应用程序时显示 TStringList 的全部内容 相反 我只是得到指示 Flist 仅显示地址 如果您使用的是 Delphi 2010 或更高版本 调试器允许使用调试可视化工具 http docwiki embarcadero
  • 以编程方式重新启动 Delphi 应用程序

    应该不可能运行我的应用程序的多个实例 因此项目源码包含 CreateMutex nil False PChar ID if GetLastError ERROR ALREADY EXISTS then Halt 现在我想以编程方式重新启动我
  • Word 2010 自动化:“转到书签”

    我有一个用 Delphi 7 编写的程序 它打开一个基于模板的新 Word 文档 文档打开后 系统会自动跳转到书签 在模板中预定义 并在其中添加一些文本 以下代码在 Word 2003 中工作正常 但会导致invalid variant o
  • 在 Delphi 中使用 XML(将特定数据返回到变量)

    过去几天我一直在尝试使用 Delphi 2010 和 MSXML 我是一个极端的新手 需要一点指导 var MemoryStream TMemoryStream XMLPath String sName String XMLDoc vari
  • 石和磅的格式正确吗?

    我有一个图表 用于显示重量 以英石和磅 lbs 为单位 该图表由记录中的数据填充 对于权重 数据类型为 Double 记录数据是在运行时编辑的 我需要知道一种正确格式化输入数据的方法 为了更好地理解 首先看一下这些示例值 它们表示为石和磅
  • 将数据从一个数据集结构移动到另一个数据集结构的更快方法(在 TDatasetProvider 中)

    我有一个自定义的 TDatasetProvider 它允许为其提供的任何数据创建新字段 因此 假设您在原始数据集上获得了以下字段 客户ID Name Age 您需要使用显示位图在 DBGrid 上选择它 好吧 你可以 因为我的 DSP 可以
  • Delphi IDE导致CPU过热

    我正在使用 Delphi 7 但我已经尝试过 Delphi 2005 2010 版本 在所有这些新版本中 当 Delphi IDE 在屏幕上可见时 我的 CPU 利用率为 50 一个核心为 100 另一个核心为 宽松 当 IDE 最小化时
  • Delphi 5 中的 Oracle 数据库连接

    我正在使用 Delphi 5 版本 我想连接到 Oracle 数据库 我有 TDatabase 组件 我不知道如何通过 Delphi 连接到数据库 请提供连接数据库的步骤 谢谢 The TDatabase http docwiki emba

随机推荐

  • 主机名未使用 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 但我知道这并不像我希望的那么容易 所以现在我要再次从头开始这个项目 我想这次能做对 这些子