新的自定义组件破坏了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的评论我认为这是有效的,但led现在并没有改变设计或运行时的颜色

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

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

Answer 1

我发现你的代码有很多问题.

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

• Color当已经有一个继承的Color属性时,正在声明一个数据成员.该数据成员是多余的和不必要的,因为它的唯一目的是进行所选择的Status从彩色SetStatus()到Paint(),这是不必需的,因为Paint()可以(也应该)直接确定该颜色值.

• 该Status属性声明与default真实的值,但该属性是在构造函数初始化为false.

• 的ColorOn和ColorOff属性setter被递归调用自身,而不是触发重绘所以可以示出新的状态的图像.

• 该Status属性setter也没有触发重绘.

话虽如此,尝试更像这样的东西:

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.