Показать сообщение отдельно
  #4  
Старый 03.07.2011, 18:40
nicht nicht вне форума
Прохожий
 
Регистрация: 18.05.2011
Сообщения: 17
Репутация: 12
По умолчанию

Опять возвращаюсь к своему вопросу. Reader и Writer вроде не то. Привожу код:
Код:
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 исчезает и из кода формы. Что здесь не так? Для меня уже принципиально стало.
Ответить с цитированием