New Custom Component Crashing the IDE

Question

This is my first attempt at creating a component, I thought I would start with a very basic LED (light bulb not text), after reading a few articles I came up with the following code (which was working), I closed down the IDE (XE10.1 update2) and when trying to use the component in a new blank empty app the IDE crashes when adding the control can anybody help :

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.

---

I have updated the code to take in comments from @Ari0nhh I think this is working but led is not changing color at design or runtime now

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

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

Answer 1

I see a number of problems with your code.

• your uses clause needs cleanup. Do not create dependencies on units you do not actually use. Units that are only used by the component's internal code should be moved to the uses clause of the implementation section. The uses clause of the interface section should only refer to units that are needed to satisfy types/references directly used by your public interface.

• a Color data member is being declared when there is already an inherited Color property. This data member is redundant and unnecessary, as its sole purpose is to carry the selected Status color from SetStatus() to Paint(), which is not necessary because Paint() can (and should) determine that color value directly.

• the Status property is declared with a default value of True, but the property is initialized to False in the constructor.

• the ColorOn and ColorOff property setters are calling themselves recursively, instead of triggering a repaint so the new state image can be shown.

• The Status property setter is also not triggering a repaint.

With that said, try something more like this instead:

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

Lets consider this code:

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

An assignment of the property ColorOff will call a SetColorOff method. Which will again assign a ColorOff property. Since there is no way to break this assignment cycle, everything will end up with a stack overflow pretty fast.