Delphi 使IDE崩溃的新自定义组件_Delphi_Crash_Ide_Components

Delphi 使IDE崩溃的新自定义组件

delphi ide

Delphi 使IDE崩溃的新自定义组件,delphi,crash,ide,components,Delphi,Crash,Ide,Components,这是我第一次尝试创建一个组件，我想我应该从一个非常基本的LED（灯泡而不是文本）开始，在阅读了几篇文章后，我想到了以下代码（这是可行的），我关闭了IDE（XE10.1更新2）当尝试在一个新的空白应用程序中使用该组件时，IDE在添加控件时崩溃，任何人都可以帮助： unit ZaxLED; interface uses Windows, Messages, Controls, Forms, Graphics, ExtCtrls, Classes, math; type TZaxLED

这是我第一次尝试创建一个组件，我想我应该从一个非常基本的LED（灯泡而不是文本）开始，在阅读了几篇文章后，我想到了以下代码（这是可行的），我关闭了IDE（XE10.1更新2）当尝试在一个新的空白应用程序中使用该组件时，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.

让我们考虑这个代码：

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

属性

ColorOff

的赋值将调用

SetColorOff

方法。这将再次分配一个

ColorOff

属性。因为没有办法打破这个分配周期，所有的事情都会很快以堆栈溢出而告终。

我发现您的代码有很多问题

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

话虽如此，请尝试类似的方法：

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.

单元ZaxLED；
接口
使用
类、控件、图形；
类型
Tzaxld=类（Tgraphic控件）
私有的
{私有声明}
FColorOn:TColor；
FColorOff:TColor；
FStatus：布尔型；
FOnChange:TNotifyEvent；
程序SetColorOn（值：TColor）；
程序设置颜色关闭（值：t颜色）；
程序SetStatus（值：布尔值）；
受保护的
{受保护的声明}
程序漆；推翻
公众的
{公开声明}
构造函数创建（AOwner:TComponent）；推翻
过程设置边界（ALeft、top、AWidth、ahheight:Integer）；推翻
出版
{已发布声明}
属性宽度默认值17；
属性高度默认值17；
属性对齐；
地产锚；
财产限制；
属性ColorOn:TColor read FColorOn write SetColorOn default clLime；
属性ColorOff:t颜色读取FColorOff写入设置ColorOff默认值clGray；
属性状态：布尔读取FStatus写入SetStatus default False；
属性OnChange:TNotifyEvent read FOnChange write FOnChange；
结束；
程序登记册；
实施
使用
数学；
程序登记册；
开始
注册表组件（'Samples'，[TZaxLED]）；
结束；
{TZaxLED}
构造函数TZaxLED.Create（所有者：TComponent）；
开始
继承的创建（AOOwner）；
FColorOn:=clLime；
FColorOff:=clGray；
FStatus:=假；
宽度：=17；
高度：=17；
结束；
程序TZaxLED.油漆；
变量
半径，X中心，Y中心：整数；
开始
如果csDesigning处于组件状态，则
开始
Canvas.Pen.Style:=psDot；
Canvas.Brush.Style:=bsClear；
画布。矩形（ClientRect）；
结束；
如果是这样的话
Canvas.Brush.Color:=FColorOn
其他的
Canvas.Brush.Color:=FColorOff；
半径：=地板（宽度/2）-2；
xCenter:=楼层（宽度/2）；
中心：=楼层（高度/2）；
椭圆（X中心-半径，Y中心-半径，X中心+半径，Y中心+半径）；
结束；
过程TZaxLED.SetBounds（ALeft、top、AWidth、ahheight:整数）；
开始
如果自动调整大小并（在[alNone，alCustom]中对齐），则
开始
宽度：=宽度；
ahheight:=高度；
结束；
继承的挫折（阿列夫特、顶、宽、高）；
结束；
程序TZaxLED.SetColorOff（值：TColor）；
开始
如果是FColorOff值，则
开始
FColorOff:=值；
如果不是FStatus，则无效；
结束；
结束；
程序TZaxLED.SetColorOn（值：TColor）；
开始
如果是FColorOn值，则
开始
FColorOn:=值；
如果是FStatus，则无效；
结束；
结束；
程序TZaxLED.SetStatus（值：布尔值）；
开始
如果值为FStatus，则
开始
FStatus:=值；
使无效
如果指定（更改），则
改变（自我）；
结束；
结束；
结束。

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

Invalidate

。

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.