Извиняюсь, что подымаю старую и закрытую тему, но у меня что-то не получается. Вот ссылка на старую тему, где вопрос вроде решили.
http://www.programmersforum.ru/showt...D%E5%ED%F2+dfm
вот исходники моего компонента:
Код:
unit CPanel;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Dialogs;
type
TCPanel = class(TPanel)
protected
{ Protected declarations }
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
end;
TPaco = class(TComponent)
private
{ Private declarations }
FParentPanel: TWinControl;
protected
{ Protected declarations }
procedure SetParentPanel(AParent: TWinControl);
procedure SetParentComponent(Value: TComponent); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
function HasParent: Boolean; override;
function GetParentComponent: TComponent; override;
property ParentPanel: TWinControl read FParentPanel write SetParentPanel;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterClasses([TPaco]);
RegisterNoIcon([TPaco]);
end;
{ TCPanel }
procedure TCPanel.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
I: Integer;
comp: TPaco;
begin
for I := 0 to ComponentCount - 1 do
begin
comp:= Components[i] as TPaco;
Proc(TPaco(comp));
end;
end;
{ TPaco }
constructor TPaco.Create(AOwner: TComponent);
begin
// inherited Create(AOwner);
FComponentStyle := [csInheritable];
Self.ParentPanel:= TWinControl(aowner);
end;
function TPaco.GetParentComponent: TComponent;
begin
if ParentPanel <> nil then
Result:= ParentPanel;
end;
function TPaco.HasParent: Boolean;
begin
Result:= True;
// Result:= FParent <> nil;
end;
procedure TPaco.SetParentPanel(AParent: TWinControl);
begin
if FParentPanel <> AParent then
begin
if FParentPanel <> nil then
FParentPanel.RemoveComponent(Self);
if AParent <> nil then
AParent.InsertComponent(Self);
FParentPanel:= AParent;
end;
end;
procedure TPaco.SetParentComponent(Value: TComponent);
begin
if not (csLoading in ComponentState) then
if (ParentPanel <> Value) and (Value is TCPanel) then
ParentPanel:= Value as TCPanel;
end;
end.
а это редактор компонента:
Код:
unit regpan;
interface
uses Classes, CPanel,DesignEditors,DesignIntf, Dialogs;
type
TCEditor = class(TComponentEditor)
procedure ExecuteVerb(Index: integer); override;
function GetVerb(Index: integer): string; override;
function GetVerbCount: integer; override;
end;
procedure Register;
implementation
{ TMyEditor }
procedure TCEditor.ExecuteVerb(Index: integer);
var
comp: TPaco;
begin
ShowMessage('Parent = '+Component.Name+'; Root name = '+Designer.Root.Name);
case Index of
0: begin
comp:=TPaco(Designer.CreateComponent(TPaco,TCPanel(Component),0,0,100,100));
comp.ParentPanel:= TCPanel(Component);
end;
else inherited ExecuteVerb(Index);
end;
end;
function TCEditor.GetVerb(Index: integer): string;
begin
case Index of
0: Result := 'Add PaCo';
else Result := inherited GetVerb(Index)
end;
end;
function TCEditor.GetVerbCount: integer;
begin
Result := inherited GetVerbCount+1;
end;
procedure Register;
begin
RegisterComponents('Standard',[TCPanel]);
RegisterComponentEditor(TCPanel,TCEditor);
end;
end.
вот код dfm файла:
Код:
object Form1: TForm1
Left = 192
Top = 113
Width = 928
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object CPanel1: TCPanel
Left = 352
Top = 64
Width = 185
Height = 41
Caption = 'CPanel1'
TabOrder = 0
object Paco1: TPaco
end
end
end
В него записано правильно. Но в Object TreeView дочерний компонент Paco1 не появляется. При повторном пересохранении Paco1 исчезает и из кода формы. Что здесь не так? Почему не получается как по ссылке. Для меня уже принципиально стало. Помогите, пожалуйста!