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

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

您的lob or blob子句需要清理。不要在您实际不使用的单元上创建依赖项。仅由组件内部代码使用的单位应移至uses部分的uses子句。 implementation部分的uses子句应仅引用满足公共接口直接使用的类型/引用所需的单位。
当已经有一个继承的interface属性时，正在声明Color数据成员。此数据成员是多余且不必要的，因为其唯一目的是将选定的Color颜色从Status传送到SetStatus()，这不是必需的，因为Paint()可以（并且应该）直接确定颜色值。
声明Paint()属性的值为Status，但属性在构造函数中初始化为False。
default和ColorOn属性设置器以递归方式调用它们，而不是触发重绘，以便显示新的状态图像。
ColorOff属性设置器也没有触发重绘。

话虽如此，请尝试更像这样的事情：

Status

Answer 2

让我们考虑一下这段代码：

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

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

新的自定义组件破坏了IDE

2 个答案: