新的自定义组件使 IDE 崩溃

Question

这是我第一次尝试创建组件，我以为我会从一个非常基本的 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;

Answer 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.

Answer 2

让我们考虑这段代码：

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

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