新的自定义组件使 IDE 崩溃

Posted

技术标签:

【中文标题】新的自定义组件使 IDE 崩溃【英文标题】：New Custom Component Crashing the IDE 【发布时间】：2017-05-28 09:43:17 【问题描述】：

这是我第一次尝试创建组件，我以为我会从一个非常基本的 LED（灯泡不是文本）开始，在阅读了几篇文章后，我想出了以下代码（有效），我关闭了关闭 IDE（XE10.1 update2），当尝试在新的空白应用程序中使用组件时，添加控件时 IDE 崩溃，任何人都可以帮忙：

unit ZaxLED;

interface

uses
  Windows, Messages, Controls, Forms, Graphics, ExtCtrls, Classes, math;

type
  TZaxLED = class(TGraphicControl)
  private
     Private declarations 
    FColorOn: Tcolor;
    FColorOff: Tcolor;
    Color: Tcolor;
    FStatus: Boolean;
    FOnChange: TNotifyEvent;

    procedure SetColorOn(Value: Tcolor);
    procedure SetColorOff(Value: Tcolor);

    function GetStatus: Boolean;
    procedure SetStatus(Value: Boolean);

  protected
     Protected declarations 
    procedure Paint; override;

  public
     Public declarations 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
     Published declarations 
    property width default 17;
    property height default 17;
    property Align;
    property Anchors;
    property Constraints;
    property ColorOn: Tcolor read FColorOn write SetColorOn default clLime;
    property ColorOff: Tcolor read FColorOff write SetColorOff default clGray;

    property Status: Boolean read GetStatus write SetStatus default True;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TZaxLED]);
end;

 TZaxLED 

constructor TZaxLED.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  width := 17;
  height := 17;
  ColorOn := clLime;
  ColorOff := clGray;
  Status := False;
  Color := ColorOff;
end;

destructor TZaxLED.Destroy;
begin
  inherited Destroy;
end;

function TZaxLED.GetStatus: Boolean;
begin
  Result := FStatus;
end;

procedure TZaxLED.Paint;
var
  Radius, xCenter, YCenter: Integer;
begin
  if csDesigning in ComponentState then
  begin
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(ClientRect);
  end;


  Canvas.Brush.Color := Color;
  Radius := Floor(width / 2) - 2;
  xCenter := Floor(width / 2);
  YCenter := Floor(height / 2);
  Canvas.Ellipse(xCenter - Radius, YCenter - Radius, xCenter + Radius,
    YCenter + Radius);

end;

procedure TZaxLED.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if Autosize and (Align in [alNone, alCustom]) then
    inherited SetBounds(ALeft, ATop, width, height)
  else
    inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TZaxLED.SetColorOff(Value: Tcolor);
begin
  FColorOff := Value;
  if not Status then
    ColorOff := Value;
end;

procedure TZaxLED.SetColorOn(Value: Tcolor);
begin
  FColorOn := Value;
  if Status then
    ColorOn := Value;
end;

procedure TZaxLED.SetStatus(Value: Boolean);
begin
  if Value <> FStatus then
  begin
    FStatus := Value;
    if FStatus then
      Color := ColorOn
    else
      Color := ColorOff;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

end.

我已经更新了从@Ari0nhh 获取 cmets 的代码，我认为这是可行的，但 led 现在在设计或运行时没有改变颜色

procedure TZaxLED.SetColorOff(Value: Tcolor);
begin
  FColorOff := Value;
end;

procedure TZaxLED.SetColorOn(Value: Tcolor);
begin
  FColorOn := Value;
end;

【问题讨论】：

我回滚了您的原始帖子并添加了您的更新，因此无需查看编辑历史记录即可看到两者。 【参考方案1】：

我发现您的代码存在许多问题。

您的uses 子句需要清理。不要在您实际不使用的单元上创建依赖项。仅由组件内部代码使用的单元应移至implementation 部分的uses 子句。 interface 部分的 uses 子句应仅引用满足公共接口直接使用的类型/引用所需的单元。

当已经有一个继承的 Color 属性时，正在声明一个 Color 数据成员。此数据成员是多余且不必要的，因为它的唯一目的是将选定的Status 颜色从SetStatus() 传送到Paint()，这不是必需的，因为Paint() 可以（并且应该）直接确定该颜色值。

Status 属性声明为 default 值为 True，但该属性在构造函数中初始化为 False。

ColorOn 和ColorOff 属性设置器递归调用自己，而不是触发重绘，以便显示新的状态图像。

Status 属性设置器也不会触发重绘。

话虽如此，请尝试更多类似的东西：

unit ZaxLED;

interface

uses
  Classes, Controls, Graphics;

type
  TZaxLED = class(TGraphicControl)
  private
     Private declarations 
    FColorOn: TColor;
    FColorOff: TColor;
    FStatus: Boolean;
    FOnChange: TNotifyEvent;

    procedure SetColorOn(Value: TColor);
    procedure SetColorOff(Value: TColor);
    procedure SetStatus(Value: Boolean);

  protected
     Protected declarations 
    procedure Paint; override;

  public
     Public declarations 
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

  published
     Published declarations 
    property Width default 17;
    property Height default 17;
    property Align;
    property Anchors;
    property Constraints;
    property ColorOn: TColor read FColorOn write SetColorOn default clLime;
    property ColorOff: TColor read FColorOff write SetColorOff default clGray;
    property Status: Boolean read FStatus write SetStatus default False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

procedure Register;

implementation

uses
  Math;

procedure Register;
begin
  RegisterComponents('Samples', [TZaxLED]);
end;

 TZaxLED 

constructor TZaxLED.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColorOn := clLime;
  FColorOff := clGray;
  FStatus := False;
  Width := 17;
  Height := 17;
end;

procedure TZaxLED.Paint;
var
  Radius, xCenter, YCenter: Integer;
begin
  if csDesigning in ComponentState then
  begin
    Canvas.Pen.Style := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(ClientRect);
  end;

  if FStatus then
    Canvas.Brush.Color := FColorOn
  else
    Canvas.Brush.Color := FColorOff;

  Radius := Floor(Width / 2) - 2;
  xCenter := Floor(Width / 2);
  YCenter := Floor(Height / 2);
  Canvas.Ellipse(xCenter - Radius, YCenter - Radius, xCenter + Radius, YCenter + Radius);
end;

procedure TZaxLED.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if AutoSize and (Align in [alNone, alCustom]) then
  begin
    AWidth := Width;
    AHeight:= Height;
  end;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TZaxLED.SetColorOff(Value: TColor);
begin
  if FColorOff  <> Value then
  begin
    FColorOff := Value;
    if not FStatus then Invalidate;
  end;
end;

procedure TZaxLED.SetColorOn(Value: TColor);
begin
  if FColorOn <> Value then
  begin
    FColorOn := Value;
    if FStatus then Invalidate;
  end;
end;

procedure TZaxLED.SetStatus(Value: Boolean);
begin
  if Value <> FStatus then
  begin
    FStatus := Value;
    Invalidate;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

end.

【讨论】：

【参考方案2】：

让我们考虑这段代码：

procedure TZaxLED.SetColorOff(Value: Tcolor);
begin
  FColorOff := Value;
  if not Status then
    ColorOff := Value;
end;

属性ColorOff 的赋值将调用SetColorOff 方法。这将再次分配一个ColorOff 属性。由于没有办法打破这个分配周期，一切都会很快以堆栈溢出告终。

【讨论】：

我取出了 If-Then 行，但它仍然崩溃 您是否更改了所有属性？它们都表现出相同的行为。 在关闭 IDE（去吃午饭）和为新的测试应用程序启动 IDE 之间没有任何改变，我已经卸载了包并通过 Component 菜单重新安装，但仍然相同（迅速失去头发) 刚刚更新了代码，似乎可以工作，但 LED 在设计或运行时没有改变颜色，我需要在所有更改中执行绘制功能（颜色等） 因为你必须在设置状态后重绘你的控件。例如致电Invalidate。

以上是关于新的自定义组件使 IDE 崩溃的主要内容，如果未能解决你的问题，请参考以下文章

微信小程序之自定义组件

微信小程序之自定义组件

使生成代码的自定义 Gradle 任务在 IDE 导入时运行

如何以编程方式设置自定义组件的自定义属性？

Flex 4中的自定义视频搜索栏控制[关闭]

Vue 2 中的自定义组件