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

时间:2010-11-22 04:41:46

标签: delphi custom-controls

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

除了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.

3 个答案:

答案 0 :(得分:7)

您可以阻止它们在表单上显示:

RegisterNoIcon([TInnerControl]);

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

虽然名称以“Control”结尾但不是普通视觉控制的类有点令人困惑。

答案 1 :(得分:5)

如果TInnerControl只在TOuterControl中使用,那么你应该在TInnerControl创建期间/之后调用SetSubComponent(True)。

答案 2 :(得分:4)

创建内部控件时,告诉他们他们的所有者是表单(外部控件的所有者)。因此,表单绘制它们,就像它绘制它拥有的所有其他组件一样。您可能希望外部控件拥有内部控件。