在Delphi中使用TOwnedCollection后代 [英] Using TOwnedCollection descendant in Delphi

问题描述

我正在尝试使用collection属性创建一个自定义组件。但是，如果我在设计时尝试通过单击对象检查器中的...按钮来打开集合编辑器，则不会发生任何反应。我缺少什么？

I'm trying to create a custom component with a collection property. However if I try to open the collection editor during design time by clicking "..." button in object inspector, nothing happens. What I am missing?

这是我的TCollection后裔：

Here's my TCollection descendant:

  TMyCollection = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TMyCollectionItem;
    procedure SetItem(Index: Integer; const Value: TMyCollectionItem);
  public
    function Add : TMyCollectionItem;
    property Items[Index: Integer]: TMyCollectionItem read GetItem write SetItem;
  end;

该项目：

 TMyCollectionItem = class(TCollectionItem)
  private
    FValue: integer;
  protected
    function GetDisplayName: string; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Value : integer read FValue write FValue;
  end;

推荐答案

您的类定义看起来正确，实现我不知道是什么问题。

Your class definitions look correct so with out seeing the entire implementation I don't know what the problem is.

下面是一个简单的单位我已经写了使用TOwnedCollection，TCollectionItem和TComponent。

Here is a simple unit I've written that uses TOwnedCollection, TCollectionItem and TComponent.

我知道这单位作品。使用它作为检查代码的基础。

I know this unit works. Use it as a basis for checking your code.

Ryan。

unit rmMultiStrings;

interface

uses classes, sysutils;

type
   ErmMultiStringNameException = Exception;
   TrmMultiStringsCollection = class;

   TrmMultiStringCollectionItem = class(TCollectionItem)
   private
     fItemDesc: string;
     fItemName: string;
     fData : TStringList;
     fMultiStrings : TrmMultiStringsCollection;
     function GetStrings: TStringList;
     function GetStringText: String;
     procedure SetItemName(const Value: string);
     procedure SetStrings(const Value: TStringList);
     procedure SetStringText(const Value: String);
   public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;

     procedure Assign(Source: TPersistent); override;
   published
     property ItemName : string read fItemName write SetItemName;
     property Description : string read fItemDesc write fItemDesc;
     property Strings : TStringList read GetStrings write SetStrings stored false;
     property Text : String read GetStringText write SetStringText;
   end;

   TrmMultiStringsCollection = class(TOwnedCollection)
   private
     function GetItem(AIndex: integer): TrmMultiStringCollectionItem;
     procedure SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
   public

     function Add: TrmMultiStringCollectionItem;

     function IndexOf(ItemName:string):integer;
     function ValueOf(ItemName:string):String;
     function ValueOfIndex(aIndex:integer):string;

     procedure Assign(Source: TPersistent); override;

     property Items[AIndex: integer] : TrmMultiStringCollectionItem read GetItem write SetItem;
   end;

   TrmMultiStrings = class(TComponent)
   private
     fData : TrmMultiStringsCollection;
     procedure SetData(const Value: TrmMultiStringsCollection);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;

     function IndexOf(ItemName:string):integer;
     function ValueOf(ItemName:string):String;
     function ValueOfIndex(aIndex:integer):string;
   published
     property Data : TrmMultiStringsCollection read fData write SetData;
   end;

procedure Register;

implementation

procedure Register;
begin
   RegisterClass(TrmMultiStringsCollection);
   RegisterClass(TrmMultiStringCollectionItem);
   RegisterComponents('rmConcordia', [TrmMultiStrings]);
end;


{ TrmMultiStringCollectionItem }

procedure TrmMultiStringCollectionItem.Assign(Source: TPersistent);
var
  wSrc : TrmMultiStringCollectionItem;
begin
  if Source is TrmMultiStringCollectionItem then
  begin
    wSrc := TrmMultiStringCollectionItem(Source);
    ItemName := wSrc.ItemName;
    Description := wSrc.Description;
    Text := wSrc.Text;
  end
  else
    inherited;
end;

constructor TrmMultiStringCollectionItem.Create(Collection: TCollection);
begin
  inherited;
  fMultiStrings := TrmMultiStringsCollection(Collection);
  fData := TStringList.create;
end;

destructor TrmMultiStringCollectionItem.Destroy;
begin
  fData.free;
  inherited;
end;

function TrmMultiStringCollectionItem.GetStrings: TStringList;
begin
   result := fData;
end;

function TrmMultiStringCollectionItem.GetStringText: String;
begin
   result := fData.Text;
end;

procedure TrmMultiStringCollectionItem.SetItemName(const Value: string);
begin
  if (fItemName <> Value) then
  begin
     if fMultiStrings.IndexOf(Value) = -1 then
        fItemName := Value
     else
        raise ErmMultiStringNameException.Create('Item name already exists');
  end;
end;

procedure TrmMultiStringCollectionItem.SetStrings(
  const Value: TStringList);
begin
   fData.Assign(Value);
end;

procedure TrmMultiStringCollectionItem.SetStringText(const Value: String);
begin
   fData.Text := Value;
end;

{ TrmMultiStringsCollection }

function TrmMultiStringsCollection.Add: TrmMultiStringCollectionItem;
begin
   result := TrmMultiStringCollectionItem(inherited Add);
   result.ItemName := 'Item_'+inttostr(NextID);
end;

procedure TrmMultiStringsCollection.Assign(Source: TPersistent);
var
   wSrc : TrmMultiStringsCollection;
   loop : integer;
begin
  if (source is TrmMultiStringsCollection)  then
  begin
     wSrc := TrmMultiStringsCollection(Source);
     Clear;
     for loop := 0 to wSrc.Count - 1 do
        Add.Assign(wSrc.Items[loop]);
  end
  else
    inherited;
end;

function TrmMultiStringsCollection.GetItem(
  AIndex: integer): TrmMultiStringCollectionItem;
begin
   result := TrmMultiStringCollectionItem(inherited Items[AIndex]);
end;

function TrmMultiStringsCollection.IndexOf(ItemName: string): integer;
var
   loop : integer;
begin
   result := -1;
   loop := 0;
   while (result = -1) and (loop < Count) do
   begin
      if (CompareText(Items[loop].ItemName, ItemName) = 0) then
         result := loop
      else
         inc(loop);
   end;
end;

procedure TrmMultiStringsCollection.SetItem(AIndex: integer; const Value: TrmMultiStringCollectionItem);
begin
  inherited SetItem(AIndex, Value)
end;

function TrmMultiStringsCollection.ValueOf(ItemName: string): String;
begin
   result := ValueOfIndex(IndexOf(ItemName));
end;

function TrmMultiStringsCollection.ValueOfIndex(aIndex: integer): string;
begin
   if (aIndex >= 0) and (aIndex < Count) then
     result := Items[aIndex].Text
   else
     result := '';
end;

{ TrmMultiStrings }

constructor TrmMultiStrings.Create(AOwner: TComponent);
begin
  inherited;
  fData := TrmMultiStringsCollection.Create(self, TrmMultiStringCollectionItem);
end;

destructor TrmMultiStrings.Destroy;
begin
  fData.Free;
  inherited;
end;

function TrmMultiStrings.IndexOf(ItemName: string): integer;
begin
   result := Data.IndexOf(ItemName);
end;

procedure TrmMultiStrings.SetData(const Value: TrmMultiStringsCollection);
begin
  fData.Assign(Value);
end;

function TrmMultiStrings.ValueOf(ItemName: string): String;
begin
   result := Data.ValueOf(ItemName);
end;

function TrmMultiStrings.ValueOfIndex(aIndex: integer): string;
begin
   result := Data.ValueOfIndex(aIndex);
end;

end.

这篇关于在Delphi中使用TOwnedCollection后代的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！