unit TestControl;

interface

uses
 Classes, StdCtrls, ActnList, DesignIntf, DesignEditors, Dialogs;

type
 TMyCollectionItem = class(TCollectionItem)
 private
   FName: string;
   FValue: Integer;
 published
   property Name: string read FName write FName;
   property Value: Integer read FValue write FValue;
 end;

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

 TMyActionList = class(TComponent)
 private
   FCollection: TMyCollection;
   FMethod: string;
   procedure ReadMethod(Reader: TReader);
   procedure WriteMethod(Writer: TWriter);
   procedure ReadCollection(Reader: TReader);
   procedure WriteCollection(Writer: TWriter);
 protected
   procedure DefineProperties(Filer: TFiler); override;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property Method: string read FMethod write FMethod;
   property Collection: TMyCollection read FCollection write FCollection;
 end;

 TMySubActionList = class(TMyActionList)
 public
   constructor Create(AOwner: TComponent); override;
 end;

 TMyTestControl = class(TEdit)
 private
   FActionList: TMySubActionList;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property ActionList: TMySubActionList read FActionList write FActionList;
 end;

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

 TMySubActionListEditor = class(TClassProperty)
 public
   procedure Edit; override;
   function GetAttributes: TPropertyAttributes; override;
 end;

implementation

uses SysUtils;

procedure SimpleModify(AActionList: TMyActionList);
var
 i: Integer;
begin
 if not Assigned(AActionList) then
 begin
   ShowMessage('not assigned');
   exit;
 end;
 AActionList.Method := 'method';
 for i:=0 to 3 do
   with AActionList.Collection.Add do
   begin
     Name := 'name'+IntToStr(i);
     Value := i;
   end;
end;

{ TMyCollection }

function TMyCollection.Add: TMyCollectionItem;
begin
 Result := TMyCollectionItem(inherited Add);
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
 Result := TMyCollectionItem(inherited GetItem(Index));
end;

procedure TMyCollection.SetItem(Index: Integer; Value: TMyCollectionItem);
begin
 inherited SetItem(Index, Value);
end;

{ TMyActionList }

constructor TMyActionList.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FCollection := TMyCollection.Create(Self, TMyCollectionItem);
 Name := 'sublist';
 SetSubComponent(True);
end;

destructor TMyActionList.Destroy;
begin
 if Assigned(FCollection) then
   FCollection.Clear;
 FreeAndNil(FCollection);
 inherited;
end;

procedure TMyActionList.DefineProperties(Filer: TFiler);

 function DoWriteMethod: Boolean;
 begin
   if Assigned(Filer.Ancestor) then
     Result:=(Filer.Ancestor as TMyActionList).Method <> Method
   else
     Result:=Method <> '';
 end;

 function DoWriteCollection: Boolean;
 begin
   if not (Filer is TWriter) then
     Result := False
   else
   if Assigned(Filer.Ancestor) then
     Result:=not CollectionsEqual(Collection, (Filer.Ancestor as TMyActionList).Collection,
       Filer.LookupRoot, TWriter(Filer).RootAncestor)
   else
     Result:=LongBool(Collection.Count);
 end;

begin
 inherited;
 Filer.DefineProperty('Method', ReadMethod, WriteMethod, DoWriteMethod);
 Filer.DefineProperty('Collection', ReadCollection, WriteCollection, DoWriteCollection);
end;

procedure TMyActionList.ReadMethod(Reader: TReader);
begin
 Method := Reader.ReadString;
end;

procedure TMyActionList.WriteMethod(Writer: TWriter);
begin
 Writer.WriteString(Method);
end;

procedure TMyActionList.ReadCollection(Reader: TReader);
begin
 Collection.Clear;
 Reader.ReadValue;
 Reader.ReadCollection(Collection);
end;

procedure TMyActionList.WriteCollection(Writer: TWriter);
begin
 Writer.WriteCollection(Collection);
end;

{ TMySubActionList }

constructor TMySubActionList.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 SetSubComponent(True);
end;

{ TMyTestControl }

constructor TMyTestControl.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FActionList := TMySubActionList.Create(Self);
end;

destructor TMyTestControl.Destroy;
begin
 FActionList.Free;
 inherited;
end;

{ TMyActionListEditor }

procedure TMyActionListEditor.ExecuteVerb(Index: Integer);
var
 LActionList: TMyActionList;
begin
 LActionList := Component as TMyActionList;
 SimpleModify(LActionList);
end;

function TMyActionListEditor.GetVerb(Index: Integer): string;
begin
 case Index of
   0: Result := 'go...';
 end;
end;

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

{ TMyActionListEditor }

procedure TMySubActionListEditor.Edit;
var
 LActionList: TMySubActionList;
begin
 LActionList := TMySubActionList(GetOrdValue);
 SimpleModify(LActionList);
end;

function TMySubActionListEditor.GetAttributes: TPropertyAttributes;
begin
 Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
end;

{initialization

 RegisterComponents('TEST', [TMyActionList, TMyTestControl]);

 RegisterComponentEditor(TMyActionList, TMyActionListEditor);
 RegisterPropertyEditor(TypeInfo(TMySubActionList), TMyTestControl, '', TMySubActionListEditor); }

end.

   ActionList.Collection = <
     item
       ActionList.Name = 'name0'
       ActionList.Value = 0
     end
     item
       ActionList.Name = 'name1'
       ActionList.Value = 1
     end
     item
       ActionList.Name = 'name2'
       ActionList.Value = 2
     end
     item
       ActionList.Name = 'name3'
       ActionList.Value = 3
     end>

   ActionList.Collection = <
     item
       Name = 'name0'
       Value = 0
     end
     item
       Name = 'name1'
       Value = 1
     end
     item
       Name = 'name2'
       Value = 2
     end
     item
       Name = 'name3'
       Value = 3
     end>

1. property EditLabel: TBoundLabel read FEditLabel; - отсутствует write
2. procedure SetName(const Value: TComponentName); override; - имя подкомнента зависит от контейнера
3. procedure Notification(AComponent: TComponent; Operation: TOperation); override; - имеется защита от удаления подкомпонента

1. procedure DefineProperties(Filer: TFiler); override; - не нужно, т.к. достаточно вынести свойства Method и Collection в published секцию и они сами сохраняться в dfm. Кроме того, нет смыла хранить в dfm то, что нельзя настроить через OI.
2. destructor TMyTestControl.Destroy;
begin
FActionList.Free; - первое уничтожение списка
inherited; - повторное уничтожение списка.