[nicht]

Привет, форумчане! Помогите, пожалуйста. Проблема вот в чем. Есть компонент, который содержит субкомпоненты TParChild, к нему прикрутил TComParEditor = class(TComponentEditor). При создании субкомпонент в design-time с помощью TComParEditor все нормально. Только в run-time все созданные ранее субкомпоненты не создаются. Ниже представляю код:

Код:

Unit ComPar;
...
*******************************
TParChild = class(TComponent)
...
***********************************
TParChildClass = class of TParChild;

TChildList = class(Tlist)
...

*****************************
TComPar = class(TCustomPanel)
FChildList: TChildList;
...
property ChildList: TChildList read FChildList;
...

var
   ParClassRegister: TStringList;
...

initialization
  ParClassRegister:= TStringList.Create;

finalization
  ParClassRegister.Free;

end.
**********************************
**********************************

unit ComParEditor;

...

type

  TComParEditor = class (TComponentEditor)
  public
    procedure Edit; override;
  end;

  TParEditorForm = class(TForm)
    ToolBar1: TToolBar;
    tbAdd: TToolButton;
    tbDel: TToolButton;
    tbUp: TToolButton;
    tbDown: TToolButton;
    ParBox: TListBox;
    MAddItem: TPopupMenu;
    procedure FormCreate(Sender: TObject);

    procedure miAddClick(Sender: TObject);
    procedure tbDelClick(Sender: TObject);
    procedure ParBoxClick(Sender: TObject);
  private
    { Private declarations }
    FPar: TComPar;
    FDesigner: IDesigner;
    procedure AddSubcomponentClass(const ACaption: String; ATag: Integer);
    procedure EnumerateSubcomponentClasses;
    function MakeSubcomponent(AOwner: TComponent; ATag: Integer): TComponent;
    procedure Refreshlist;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent; APar: TComPar; ADesigner: IDesigner); reintroduce;
  end;

procedure Register;

var
  ParEditorForm: TParEditorForm;

implementation

{$R *.dfm}

procedure Register;
begin
  RegisterComponentEditor(TComPar, TComParEditor);
end;  

{ TComParEditor }

procedure TComParEditor.Edit;
begin
  ParEditorForm:= TParEditorForm.Create(Application, (GetComponent as TComPar), GetDesigner);
  try
    ParEditorForm.ShowModal;
  finally
    ParEditorForm.Free;
  end;
  Designer.Modified;
end;

procedure TParEditorForm.AddSubcomponentClass(const ACaption: String; ATag: Integer);
var
  mi: TMenuItem;
begin
  if ACaption = '' then exit; // Empty names denote deprecated components.
  mi := TMenuItem.Create(Self);
  mi.OnClick := miAddClick;
  mi.Caption := ACaption;
  mi.Tag := ATag;
  MAddItem.Items.Add(mi);
end;

constructor TParEditorForm.Create(AOwner: TComponent; APar: TComPar; ADesigner: IDesigner);
begin
  inherited Create(AOwner);
  FPar:= APar;
  FDesigner:= ADesigner;
  EnumerateSubcomponentClasses;
  Refreshlist;
end;

procedure TParEditorForm.EnumerateSubcomponentClasses;
var
  i: Integer;
begin
 for i := 0 to SeriesClassRegister.Count - 1 do
   AddSubcomponentClass(SeriesClassRegister[i], i);
end;

procedure TGSeriesEditorForm.FormCreate(Sender: TObject);
begin
  Caption:= FPar.Name + ' editor';
end;

function TParEditorForm.MakeSubcomponent(AOwner: TComponent;
  ATag: Integer): TComponent;
begin
  Result:= TParChildClass(ChildClassRegister.Objects[ATag]).Create(AOwner);
end;

procedure TParEditorForm.miAddClick(Sender: TObject);
var
  s: TComponent;
  n: String;
begin
  s:= MakeSubcomponent(FPar.Owner, (Sender as TMenuItem).Tag);
  try
    n:= Copy(s.ClassName, 2, Length(s.ClassName) - 1);
    s.Name:= FDesigner.UniqueName(n);
    FPar.AddChild(s as TParChild);
    ParBox.AddItem(s.Name, s);
    FDesigner.Modified;
    Refreshlist;
  except
    s.Free;
    raise;
  end;
end;

procedure TParEditorForm.Refreshlist;
var
  ci: TStrings;
  i: Integer;
begin
  ci:= ParBox.Items;
  try
    ci.BeginUpdate;
    ci.Clear;
    with FPar.ChildList do
      for i:= 0 to Count - 1 do
        ci.AddObject(TComponent(Items[i]).Name, TObject(Items[i]));
  finally
    ci.EndUpdate;
  end;
end;

procedure TParEditorForm.tbDelClick(Sender: TObject);
var
  i: Integer;
  s: TComponent;
begin
  if ParBox.SelCount = 0 then exit;
  for i := ParBox.Items.Count - 1 downto 0 do
    if ParBox.Selected[i] then
    begin
      s:= TComponent(ParBox.Items.Objects[i]);
      ParBox.Items.Delete(i);
      s.Free;
    end;
  FDesigner.Modified;
  Refreshlist;
end;

procedure TParEditorForm.ParBoxClick(Sender: TObject);
begin
  FDesigner.SelectComponent((ParBox.Items.Objects[ParBox.ItemIndex]) as TPersistent);
end;

end.

Что еще нужно дописать, чтобы работало? Где я не прав? В литературе ничего подобного не нашел.

[nicht]

то есть надо реализовать аналог создания TSeies в TChart в дизайн-тайме. Заранее спасибо

[lmikle]

подозреваю, что надо писать кастом reader и writer для дочернего компонента.

[nicht]

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

[nicht]

Неужели никто не знает как решить этот вопрос. Я уже в тупике, но ведь люди как-то делали такое!