|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Проблема с Редактором Компонентов
Привет, форумчане! Помогите, пожалуйста. Проблема вот в чем. Есть компонент, который содержит субкомпоненты 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. Что еще нужно дописать, чтобы работало? Где я не прав? В литературе ничего подобного не нашел. |
#2
|
|||
|
|||
то есть надо реализовать аналог создания TSeies в TChart в дизайн-тайме. Заранее спасибо
|
#3
|
|||
|
|||
подозреваю, что надо писать кастом reader и writer для дочернего компонента.
|
#4
|
|||
|
|||
Опять возвращаюсь к своему вопросу. 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. Код:
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 |
#5
|
|||
|
|||
Неужели никто не знает как решить этот вопрос. Я уже в тупике, но ведь люди как-то делали такое!
|