8

次のコード (パッケージに登録されている場合) は、TParentComponentregistered in the palletというコンポーネントを提供しますTest。

ただし、(同じコードで提供されている) プロパティ エディターを使用して子オブジェクトを作成すると、IDE は、名前のないコンポーネントのメソッドを作成できませんというエラー メッセージを表示します。

奇妙なのは、Child オブジェクトには実際に名前があることです。

ソースは次のとおりです。

unit TestEditorUnit;

interface

uses
  Classes, DesignEditors, DesignIntf;

type  
  TParentComponent = class;

  TChildComponent = class(TComponent)
  private
    FParent: TParentComponent;
    FOnTest: TNotifyEvent;
    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;
  published
    property OnTest: TNotifyEvent read FOnTest write FOnTest;
  end;

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

  TParentPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

procedure Register;

implementation

uses
  ColnEdit;

type
  TChildComponentCollectionItem = class(TCollectionItem)
  private
    FChildComponent: TChildComponent;
    function GetName: string;
    function GetOnTest: TNotifyEvent;
    procedure SetName(const Value: string);
    procedure SetOnTest(const Value: TNotifyEvent);
  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;
    property OnTest: TNotifyEvent read GetOnTest write SetOnTest;
  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]);
  RegisterPropertyEditor(TypeInfo(TList), TParentComponent, 'Childs', TParentPropertyEditor);
end;

{ 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
    TComponent(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;

{ 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;

function TChildComponentCollectionItem.GetOnTest: TNotifyEvent;
begin
  Result := FChildComponent.OnTest;
end;

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

procedure TChildComponentCollectionItem.SetOnTest(const Value: TNotifyEvent);
begin
  FChildComponent.OnTest := Value;
end;

{ TParentPropertyEditor }

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

function TParentPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TParentPropertyEditor.GetValue: string;
begin
  Result := 'Childs';
end;

end.

上記のソースは、 StackOverflow の別の回答から改作されました。

のメソッドを作成できない理由はありますOnTestか?

前もって感謝します！

4

2 に答える 2

6

設計時間要件の要約

  • 複数の子コンポーネントを保持できるカスタム コンポーネントが必要な場合。
  • これらの子コンポーネントは、そのカスタム コンポーネントによって作成されます。
  • 子コンポーネントは、設計時に配置される通常のコンポーネントと同様に、コード内でその名前で参照できる必要があります。したがって、ではなくForm.CustomComponent.Children[0]、Form.Child1代わりに。
  • したがって、子コンポーネントは、モジュール (フォーム、フレーム、またはデータモジュール) のソース ファイルで宣言し、追加する必要があります。
  • 子コンポーネントは、デフォルトの IDE コレクション エディターによって管理されます。
  • したがって、子は に完全にラップする必要がありTCollectionItemます。

現在のコードの評価

あなたはすでにうまくいっていますが、あなたの質問に加えて、コードには改善すべき点がいくつかあります。

  • 作成したコレクションは決して解放されません。
  • コレクション エディターを表示するたびに、新しいコレクションが作成されます。
  • TreeView から子を削除すると、古い対応する CollectionItem が残り、AV が発生します。
  • 設計時と実行時のコードは分割されません。

解決

これは、次の変更を加えた、書き直された作業バージョンのコードです。

  • 親が Delphi のものと混同しすぎているMasterため、特別なコンポーネントは と呼ばれます(すでに 2 種類あります)。したがって、子供は と呼ばれます。ParentSlave
  • スレーブはTComponentList(ユニットContnrs) に保持され、個々のスレーブが破棄された場合にリストが自動的に更新されます。ComponentList はスレーブを所有します。
  • 1 つのマスターごとに、1 つのコレクションのみが作成されます。これらのマスター コレクションの組み合わせは、個別のTStockItemsObjectList に保持されます。リストはストック アイテムを所有し、リストはファイナライズ セクションで解放されます。
  • GetNamePathSlave1としてではなく、オブジェクト インスペクタでスレーブが として表示されるように実装されていSlaveWrappers(0)ます。
  • TSlaveWrapper クラスのイベント用に追加のプロパティ エディターが追加されました。どういうわけかGetFormMethodName、デフォルトのTMethodProperty結果がエラーになります。原因はにありDesigner.GetObjectNameますが、正確な理由はわかりません。今GetFormMethodNameはオーバーライドされています。これにより、質問の問題が解決されます。

備考

(コレクション エディターの矢印ボタンを使用して) コレクション内のアイテムの順序で行われた変更は、まだ保存されていません。それを実装するために自分自身を試してみてください。

SlavesTreeView では、各スレーブは、コレクションで通常見られるプロパティの子ではなく、マスターの直接の子になりました。

ここに画像の説明を入力

TSlavesこれが起こるためには、から派生する必要があると思います.ComponentListTPersistentはその中にラップされます. それは確かに別の素晴らしい試みです.

コンポーネントコード

unit MasterSlave;

interface

uses
  Classes, Contnrs;

type
  TMaster = class;

  TSlave = class(TComponent)
  private
    FMaster: TMaster;
    FOnTest: TNotifyEvent;
    procedure SetMaster(Value: TMaster);
  protected
    procedure SetParentComponent(AParent: TComponent); override;
  public
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    property Master: TMaster read FMaster write SetMaster;
  published
    property OnTest: TNotifyEvent read FOnTest write FOnTest;
  end;

  TSlaves = class(TComponentList)
  private
    function GetItem(Index: Integer): TSlave;
    procedure SetItem(Index: Integer; Value: TSlave);
  public
    property Items[Index: Integer]: TSlave read GetItem write SetItem; default;
  end;

  TMaster = class(TComponent)
  private
    FSlaves: TSlaves;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Slaves: TSlaves read FSlaves;
  end;

implementation

{ TSlave }

function TSlave.GetParentComponent: TComponent;
begin
  Result := FMaster;
end;

function TSlave.HasParent: Boolean;
begin
  Result := FMaster <> nil;
end;

procedure TSlave.SetMaster(Value: TMaster);
begin
  if FMaster <> Value then
  begin
    if FMaster <> nil then
      FMaster.FSlaves.Remove(Self);
    FMaster := Value;
    if FMaster <> nil then
      FMaster.FSlaves.Add(Self);
  end;
end;

procedure TSlave.SetParentComponent(AParent: TComponent);
begin
  if AParent is TMaster then
    SetMaster(TMaster(AParent));
end;

{ TSlaves }

function TSlaves.GetItem(Index: Integer): TSlave;
begin
  Result := TSlave(inherited Items[Index]);
end;

procedure TSlaves.SetItem(Index: Integer; Value: TSlave);
begin
  inherited Items[Index] := Value;
end;

{ TMaster }

constructor TMaster.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSlaves := TSlaves.Create(True);
end;

destructor TMaster.Destroy;
begin
  FSlaves.Free;
  inherited Destroy;
end;

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

end.

エディタ コード

unit MasterSlaveEdit;

interface

uses
  Classes, SysUtils, MasterSlave, Contnrs, DesignEditors, DesignIntf, ColnEdit;

type
  TMasterEditor = class(TComponentEditor)
  private
    function Master: TMaster;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): String; override;
    function GetVerbCount: Integer; override;
  end;

  TMasterProperty = class(TPropertyEditor)
  private
    function Master: TMaster;
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: String; override;
  end;

  TOnTestProperty = class(TMethodProperty)
  private
    function Slave: TSlave;
  public
    function GetFormMethodName: String; override;
  end;

  TSlaveWrapper = class(TCollectionItem)
  private
    FSlave: TSlave;
    function GetName: String;
    function GetOnTest: TNotifyEvent;
    procedure SetName(const Value: String);
    procedure SetOnTest(Value: TNotifyEvent);
  protected
    function GetDisplayName: String; override;
  public
    constructor Create(Collection: TCollection); override;
    constructor CreateSlave(Collection: TCollection; ASlave: TSlave);
    destructor Destroy; override;
    function GetNamePath: String; override;
  published
    property Name: String read GetName write SetName;
    property OnTest: TNotifyEvent read GetOnTest write SetOnTest;
  end;

  TSlaveWrappers = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TSlaveWrapper;
  public
    property Items[Index: Integer]: TSlaveWrapper read GetItem; default;
  end;

implementation

type
  TStockItem = class(TComponent)
  protected
    Collection: TSlaveWrappers;
    Designer: IDesigner;
    Master: TMaster;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    destructor Destroy; override;
  end;

  TStockItems = class(TObjectList)
  private
    function GetItem(Index: Integer): TStockItem;
  protected
    function CollectionOf(AMaster: TMaster; Designer: IDesigner): TCollection;
    function Find(ACollection: TCollection): TStockItem;
    property Items[Index: Integer]: TStockItem read GetItem;
      default;
  end;

var
  FStock: TStockItems = nil;

function Stock: TStockItems;
begin
  if FStock = nil then
    FStock := TStockItems.Create(True);
  Result := FStock;
end;

{ TStockItem }

destructor TStockItem.Destroy;
begin
  Collection.Free;
  inherited Destroy;
end;

procedure TStockItem.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    for I := 0 to Collection.Count - 1 do
      if Collection[I].FSlave = AComponent then
      begin
        Collection[I].FSlave := nil;
        Collection.Delete(I);
        Break;
      end;
end;

{ TStockItems }

function TStockItems.CollectionOf(AMaster: TMaster;
  Designer: IDesigner): TCollection;
var
  I: Integer;
  Item: TStockItem;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Master = AMaster then
    begin
      Result := Items[I].Collection;
      Break;
    end;
  if Result = nil then
  begin
    Item := TStockItem.Create(nil);
    Item.Master := AMaster;
    Item.Designer := Designer;
    Item.Collection := TSlaveWrappers.Create(AMaster, TSlaveWrapper);
    for I := 0 to AMaster.Slaves.Count - 1 do
    begin
      TSlaveWrapper.CreateSlave(Item.Collection, AMaster.Slaves[I]);
      Item.FreeNotification(AMaster.Slaves[I]);
    end;
    Add(Item);
    Result := Item.Collection;
  end;
end;

function TStockItems.GetItem(Index: Integer): TStockItem;
begin
  Result := TStockItem(inherited Items[Index]);
end;

function TStockItems.Find(ACollection: TCollection): TStockItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Collection = ACollection then
    begin
      Result := Items[I];
      Break;
    end;
end;

{ TMasterEditor }

procedure TMasterEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowCollectionEditor(Designer, Master,
      Stock.CollectionOf(Master, Designer), 'Slaves');
  end;
end;

function TMasterEditor.GetVerb(Index: Integer): String;
begin
  case Index of
    0: Result := 'Edit slaves...';
  else
    Result := '';
  end;
end;

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

function TMasterEditor.Master: TMaster;
begin
  Result := TMaster(Component);
end;

{ TMasterProperty }

procedure TMasterProperty.Edit;
begin
  ShowCollectionEditor(Designer, Master,
    Stock.CollectionOf(Master, Designer), 'Slaves');
end;

function TMasterProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TMasterProperty.GetValue: String;
begin
  Result := Format('(%s)', [Master.Slaves.ClassName]);
end;

function TMasterProperty.Master: TMaster;
begin
  Result := TMaster(GetComponent(0));
end;

{ TOnTestProperty }

function TOnTestProperty.GetFormMethodName: String;
begin
  Result := Slave.Name + GetTrimmedEventName;
end;

function TOnTestProperty.Slave: TSlave;
begin
  Result := TSlaveWrapper(GetComponent(0)).FSlave;
end;

{ TSlaveWrapper }

constructor TSlaveWrapper.Create(Collection: TCollection);
begin
  CreateSlave(Collection, nil);
end;

constructor TSlaveWrapper.CreateSlave(Collection: TCollection; ASlave: TSlave);
var
  Item: TStockItem;
begin
  inherited Create(Collection);
  if ASlave = nil then
  begin
    Item := Stock.Find(Collection);
    FSlave := TSlave.Create(Item.Master.Owner);
    FSlave.Name := Item.Designer.UniqueName(TSlave.ClassName);
    FSlave.Master := Item.Master;
    FSlave.FreeNotification(Item);
  end
  else
    FSlave := ASlave;
end;

destructor TSlaveWrapper.Destroy;
begin
  FSlave.Free;
  inherited Destroy;
end;

function TSlaveWrapper.GetDisplayName: String;
begin
  Result := Name;
end;

function TSlaveWrapper.GetName: String;
begin
  Result := FSlave.Name;
end;

function TSlaveWrapper.GetNamePath: String;
begin
  Result := FSlave.GetNamePath;
end;

function TSlaveWrapper.GetOnTest: TNotifyEvent;
begin
  Result := FSlave.OnTest;
end;

procedure TSlaveWrapper.SetName(const Value: String);
begin
  FSlave.Name := Value;
end;

procedure TSlaveWrapper.SetOnTest(Value: TNotifyEvent);
begin
  FSlave.OnTest := Value;
end;

{ TSlaveWrappers }

function TSlaveWrappers.GetItem(Index: Integer): TSlaveWrapper;
begin
  Result := TSlaveWrapper(inherited Items[Index]);
end;

initialization

finalization
  FStock.Free;

end.

登録コード

unit MasterSlaveReg;

interface

uses
  Classes, MasterSlave, MasterSlaveEdit, DesignIntf;

procedure Register;

implementation

procedure Register;
begin
  RegisterClass(TSlave);
  RegisterNoIcon([TSlave]);
  RegisterComponents('Samples', [TMaster]);
  RegisterComponentEditor(TMaster, TMasterEditor);
  RegisterPropertyEditor(TypeInfo(TSlaves), TMaster, 'Slaves',
    TMasterProperty);
  RegisterPropertyEditor(TypeInfo(TNotifyEvent), TSlaveWrapper, 'OnTest',
    TOnTestProperty);
end;

end.

パッケージコード

requires
  rtl,
  DesignIDE;

contains
  MasterSlave in 'MasterSlave.pas',
  MasterSlaveEdit in 'MasterSlaveEdit.pas',
  MasterSlaveReg in 'MasterSlaveReg.pas';
于 2013-05-10T02:24:42.987 に答える
1

About.com の「Creating Custom Delphi Components, Part 2, Page 4 of 5」という記事で、十分な「回避策」が見つかりました。

完全なサンプル ソースは記事にあり、Delphi のすべてのバージョンで (一見) 動作します。

ただし、コレクション エディターを親コンポーネントと子コンポーネントから分離できないため、このソリューションは完全ではないことに注意してください(つまり、コレクション エディターを機能させるには、両方のコンポーネントのソースを作成する必要があります。それをランタイム パッケージに配置します)。

今の私のニーズでは、これで十分です...しかし、誰かが私の質問に投稿されたサンプルコードに直接基づいてより良い解決策を見つけることができれば、それは素晴らしいことです(誰かが提供した場合、その答えを正しいとマークします）。

于 2013-05-06T21:23:04.997 に答える