5

我需要了解制作組件並生成和管理子組件的基礎知識。我最初嘗試通過創建一個TCollection,並試圖在每個TCollectionItem上設置一個名稱。但我知道這並不像我所希望的那麼容易。使用命名的子組件創建組件?

所以現在我要再次從頭開始這個項目,這次我想說得對。這些子組件不是可視組件,不應具有任何顯示或窗口,僅基於TComponent。包含這些子組件的主要組件也將基於TComponent。所以這裏沒有什麼是可視化的,我不想在我的表單上(設計時)爲每個這些子組件設置一個小圖標。

我希望能夠以集合式的方式維護和管理這些子組件。重要的是這些子組件應該被創建,命名並添加到表單源中,就像例如菜單項一樣。這首先是整個想法的重點,如果它們不能被命名,那麼這個想法就是一個概念。

另一件重要的事情是:作爲所有子組件父項的主要組件必須能夠將這些子組件保存到DFM文件中。

例:

而不是訪問這些子項等中的一種:

MyForm.MyItems[1].DoSomething(); 

我反而喜歡做這樣的事情:

MyForm.MyItem2.DoSomething(); 

所以我沒有依靠知道每個子項目的ID。

編輯:

我覺得這一點必須包括我原來的代碼,以便它可以看到原來的集合是如何工作的。這裏只是從全單元剝離服務器端採集和收集物品:

// 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; 
+0

你可以研究你引用的三個「類似的現有事物」的源代碼。 Delphi開發人員是如何實現這個的? –

+0

現在,在您編輯之後,您很清楚它到底是什麼:不,這是不可能的。但我懷疑這真的是你的願望。你爲什麼要在代碼中按名稱尋址收集項目? – NGLN

+0

也許不是從代碼中引用的實際集合項目,而是在每個集合項目後面創建一些隱藏組件,這些項目的名稱將保存在DFM中。然而正如你在下面的另一個註釋中提到的,我不確定當它已經顯示TCollectionItem的屬性時,如何在對象檢查器中顯示該組件的屬性? –

回答

8

This Thread幫我創造了一些東西,就像我們昨天討論的那樣。我把這個軟件包發佈到那裏並修改了一下。這裏是來源:

TestComponents。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. 

TestComponentsReg.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內編輯它們。

+2

+1非常好。我懷疑需要使用'Designer.CreateComponent'來將元素添加到源文件中,但'Designer.Modified'會很好地處理。好找! – NGLN

+0

@Jerry將'DesignIDE'添加到您的軟件包源文件的require部分。請參閱[Proxies.pas發生了什麼?](http://edn.embarcadero.com/article/27717)。 – NGLN

+0

它是美麗的!我欠你太多。 –

1

實施TCollectionItem.GetDisplayName爲「名」的藏品。

而關於集合:當這是已發佈的屬性時,集合將自動命名爲屬性名稱。

當您創建TPersistent的屬性時,請注意implement GetOwner

+0

不,我不是指'顯示名稱'我更意識到這一點。我需要創建另一個不可見的組件來表示每個項目,一個命名的組件。 –

+2

它需要從TComponent繼承的原因是什麼? –

+0

我可以從任何東西繼承它,只要它不是可視的,並且它可以在表格的類中有一個名稱 - 我假設組件是最合適的,但是如果我錯了,請糾正我。 –

2

使用TComponent.SetSubComponent程序:

type 
    TComponent1 = class(TComponent) 
    private 
    FSubComponent: TComponent; 
    procedure SetSubComponent(Value: TComponent); 
    public 
    constructor Create(AOwner: TComponent); override; 
    published 
    property SubComponent: TComponent read FSubComponent write SetSubComponent; 
    end; 

procedure Register; 

implementation 

procedure Register; 
begin 
    RegisterComponents('Samples', [TComponent1]); 
end; 

{ TComponent1 } 

constructor TComponent1.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    FSubComponent := TComponent.Create(Self); // Nót AOwner as owner here !! 
    FSubComponent.Name := 'MyName'; 
    FSubComponent.SetSubComponent(True); 
end; 

procedure TComponent1.SetSubComponent(Value: TComponent); 
begin 
    FSubComponent.Assign(Value); 
end; 

我現在明白這個子組件將是一個集合項目的一部分。在這種情況下:沒有區別,請使用此方法。

+0

當然,這可能會工作得更大。該示例使用一個沒有集合的單個子組件,但它可能會從TCollectionItem中使用它。但是這實際上是否會創建一個新的組件,並保存在表單的類中? –

+0

是的。從我的鏈接引用:_Unless這樣的組件調用SetSubComponent與IsSubComponent設置爲True,其發佈的屬性將不會保存到窗體文件._ – NGLN

+0

實際上,我看不到如何使這個子組件的屬性在Object Inspector中可見,因爲真正選擇在Object Inspector中顯示的內容是集合編輯器中的項目(TCollectionItem) –