delphi - 防止 Delphi IDE 在设计时创建组件图标

Question

我创建了一个自定义控件 TOuterControl，它是多个 TInnerControl 的父级。

一切工作正常，除了 IDE 正在为每个子 TInnerControl 创建图标(屏幕截图中的 InnerControl1 和 InnerControl2)。如何阻止 IDE 生成图标？

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.

Answer 1

您可以通过以下方式阻止它们出现在表单上:

RegisterNoIcon([TInnerControl]);

有关 RegisterNoIcon 的更多信息，请访问 http://docwiki.embarcadero.com/VCL/e/index.php/Classes.RegisterNoIcon

名称以“Control”结尾的类有点令人困惑，但它们不是普通的视觉控件。