Запретить Delphi IDE создавать значки компонентов во время разработки

Я создал пользовательский элемент управления TOuterControl, который является родительским элементом для нескольких элементов управления TInnerControl.

Все работает нормально, за исключением того, что среда IDE является создание значков для каждого дочернего элемента управления TInnerControl (InnerControl1 и InnerControl2 на снимке экрана). Как запретить IDE создавать значки?

alt text

unit TestControl;

interface

Procedure Register;

implementation

Uses
    Classes,
    Controls,
    SysUtils,
    DesignEditors,
    DesignIntf,
    VCLEditors;

Type

TOuterControl = Class;

TInnerControl = Class(TComponent)
Protected
    FOuterControl : TOuterControl;

    function GetParentComponent: TComponent; Override;
    Function HasParent : Boolean; Override;
    procedure SetParentComponent                  (Value: TComponent); Override;
End;

TOuterControl = Class(TCustomControl)
Protected
    FInnerControls : TList;

    Procedure Paint; Override;
Public
    Constructor Create(AOwner : TComponent); Override;
    Procedure AddInnerControl(AInnerControl : TInnerControl);
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
End;

TOuterControlEditor = Class(TDefaultEditor)
Public
    Procedure ExecuteVerb(Index : Integer);          Override;
    Function  GetVerb    (Index : Integer) : String; Override;
    Function  GetVerbCount      : Integer;           Override;
End;

procedure TOuterControl.AddInnerControl(AInnerControl: TInnerControl);
begin
    AInnerControl.FOuterControl := Self;;
    FInnerControls.Add(AInnerControl);
    Invalidate;
end;

constructor TOuterControl.Create(AOwner: TComponent);
begin
    inherited;

    FInnerControls := TList.Create;
end;

procedure TOuterControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
    I : Integer;
begin
    inherited;

    For I := 0 To FInnerControls.Count - 1 Do
        Proc(FInnerControls[I]);
end;

procedure TOuterControl.Paint;
begin
    inherited;

    Canvas.FillRect(ClientRect);
    Canvas.TextOut(0,0, Format('Inner Control Count = %d', [FInnerControls.Count]));
end;

function TInnerControl.GetParentComponent: TComponent;
begin
    Result := FOuterControl;
end;

function TInnerControl.HasParent: Boolean;
begin
    Result := True;
end;

procedure TInnerControl.SetParentComponent(Value: TComponent);
begin
    If Value Is TOuterControl Then
        If FOuterControl <> Value Then
    Begin
        FOuterControl := TOuterControl(Value);
        FOuterControl.AddInnerControl(Self);
    End;
end;

procedure TOuterControlEditor.ExecuteVerb(Index: Integer);
Var
    OuterControl : TOuterControl;
    InnerControl : TInnerControl;
begin
    inherited;

    OuterControl := TOuterControl(Component);

    If Index = 0 Then
    Begin
        InnerControl := TInnerControl.Create(OuterControl.Owner);
        OuterControl.AddInnerControl(InnerControl);
    End;
end;

function TOuterControlEditor.GetVerb(Index: Integer): String;
begin
    Result := 'Add Inner';
end;

function TOuterControlEditor.GetVerbCount: Integer;
begin
    Result := 1;
end;

Procedure Register;
Begin
    RegisterComponents('AA', [TOuterControl]);
    RegisterComponentEditor(TOuterControl, TOuterControlEditor);
End;


Initialization
    Classes.RegisterClasses([TInnerControl]);

end.
6
задан Frank 22 November 2010 в 05:48
поделиться