Delphi TCustomTransparentControl dissapears

我已经使用TCustomTransparentControl创建了一个组件。 它运行良好，但在同一个父级上有多个实例。 当我单击其中一个实例时，其他实例似乎随机出现。（这不是完全随机的，但我无法理解逻辑） 当我单击实例所在的位置时，它会正确显示。 这是我的密码

unit TestComponent;

interface

uses
  System.SysUtils, System.Classes, System.Types, Vcl.Controls,VCL.Graphics,Windows,Messages;

type
  TCustomTransparentControl1 = class(TCustomTransparentControl)
  private
    FPoints:array of TPoint;
    procedure FDoClick(Sender: TObject);
  protected
    procedure Paint; override;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy;
     procedure CreateParams(var Params: TCreateParams); override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('SCADA', [TCustomTransparentControl1]);
end;



{ TCustomTransparentControl1 }

constructor TCustomTransparentControl1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls,csClickEvents];
  interceptmouse:=True;
  Width:=50;
  Height:=50;
  OnClick:=FDoClick;
end;

procedure TCustomTransparentControl1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_Transparent;
end;

destructor TCustomTransparentControl1.Destroy;
begin
  inherited;
end;

procedure TCustomTransparentControl1.FDoClick(Sender: TObject);
begin
  if Not Focused then
    begin
      SetFocus;
      Invalidate;
    end;
end;

procedure TCustomTransparentControl1.Paint;
begin
  inherited;
  Canvas.Brush.Style := bsSolid;
  if Focused then
    begin
      Canvas.Brush.Color := clGreen;
    end
  else
    begin
      Canvas.Brush.Color := clYellow;
    end;
  SetLength(FPoints,4);
  FPoints[0]:=Point(0,0);
  FPoints[1]:=Point(Width,0);
  FPoints[2]:=Point(Width,Height);
  FPoints[3]:=Point(0,Height);
  Canvas.Polygon(FPoints);
end;

end.

---

提前感谢您的帮助

您的控件中有许多错误

必须重写

析构函数

，必须实现

WM_SETFOCUS

和

WM_KILLFOCUS

的处理程序，不应从鼠标单击事件中无效，应重写

click（）

而不是使用

OnClick

，绘制过程应使用

Width-1

和

Height-1

，不需要重写

CreateParams

，因为它已经在基类中完成了

这是我的固定版本，包含所有这些更改：

unit VclTransparentControl;

interface

uses
    Windows,Messages,
    System.SysUtils, System.Classes, System.Types,
    Vcl.Controls,VCL.Graphics;

type
    TCustomTransparentControl1 = class(TCustomTransparentControl)
    private
        FPoints : array of TPoint;
        procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
        procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    protected
        procedure Paint; override;
        procedure Click; override;
    public
         constructor Create(AOwner: TComponent); override;
         destructor Destroy; override;
    published
        property TabStop;
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('TestTransparentControl', [TCustomTransparentControl1]);
end;

{ TCustomTransparentControl1 }

constructor TCustomTransparentControl1.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    ControlStyle   := ControlStyle + [csAcceptsControls,csClickEvents];
    InterceptMouse := True;
    Width          := 50;
    Height         := 50;
    TabStop        := TRUE;
end;

destructor TCustomTransparentControl1.Destroy;
begin
    inherited;
end;

procedure TCustomTransparentControl1.Click;
begin
    if not Focused then
        SetFocus;
end;

procedure TCustomTransparentControl1.Paint;
begin
    inherited;
    Canvas.Brush.Style := bsSolid;
    if Focused then
        Canvas.Brush.Color := clGreen
    else
        Canvas.Brush.Color := clYellow;
    SetLength(FPoints,4);
    FPoints[0] := Point(0,         0);
    FPoints[1] := Point(Width - 1, 0);
    FPoints[2] := Point(Width - 1, Height - 1);
    FPoints[3] := Point(0,         Height - 1);
    Canvas.Polygon(FPoints);
end;

procedure TCustomTransparentControl1.WMKillFocus(var Message: TWMKillFocus);
begin
    inherited;
    Invalidate;
end;

procedure TCustomTransparentControl1.WMSetFocus(var Message: TWMSetFocus);
begin
    inherited;
    Invalidate;
end;

end.

---

使用Delphi 10.4.1进行测试。

控件中存在许多错误

必须重写

析构函数

，必须实现

WM_SETFOCUS

和

WM_KILLFOCUS

的处理程序，不应从鼠标单击事件中无效，应重写

click（）

而不是使用

OnClick

，绘制过程应使用

Width-1

和

Height-1

，不需要重写

CreateParams

，因为它已经在基类中完成了

这是我的固定版本，包含所有这些更改：

unit VclTransparentControl;

interface

uses
    Windows,Messages,
    System.SysUtils, System.Classes, System.Types,
    Vcl.Controls,VCL.Graphics;

type
    TCustomTransparentControl1 = class(TCustomTransparentControl)
    private
        FPoints : array of TPoint;
        procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
        procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    protected
        procedure Paint; override;
        procedure Click; override;
    public
         constructor Create(AOwner: TComponent); override;
         destructor Destroy; override;
    published
        property TabStop;
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('TestTransparentControl', [TCustomTransparentControl1]);
end;

{ TCustomTransparentControl1 }

constructor TCustomTransparentControl1.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    ControlStyle   := ControlStyle + [csAcceptsControls,csClickEvents];
    InterceptMouse := True;
    Width          := 50;
    Height         := 50;
    TabStop        := TRUE;
end;

destructor TCustomTransparentControl1.Destroy;
begin
    inherited;
end;

procedure TCustomTransparentControl1.Click;
begin
    if not Focused then
        SetFocus;
end;

procedure TCustomTransparentControl1.Paint;
begin
    inherited;
    Canvas.Brush.Style := bsSolid;
    if Focused then
        Canvas.Brush.Color := clGreen
    else
        Canvas.Brush.Color := clYellow;
    SetLength(FPoints,4);
    FPoints[0] := Point(0,         0);
    FPoints[1] := Point(Width - 1, 0);
    FPoints[2] := Point(Width - 1, Height - 1);
    FPoints[3] := Point(0,         Height - 1);
    Canvas.Polygon(FPoints);
end;

procedure TCustomTransparentControl1.WMKillFocus(var Message: TWMKillFocus);
begin
    inherited;
    Invalidate;
end;

procedure TCustomTransparentControl1.WMSetFocus(var Message: TWMSetFocus);
begin
    inherited;
    Invalidate;
end;

end.

---

使用Delphi 10.4.1进行测试。

错误：

析构函数Destroy

必须是

析构函数Destroy；重写

此外，作为控件作者，您不应该使用

OnClick

。相反，重写

单击

方法。错误：

析构函数销毁

必须是

析构函数销毁；重写

此外，作为控件作者，您不应该使用

OnClick

。相反，重写

单击

方法。您好，谢谢您的回答，如果控件上有两个组件，它就会工作，只要我有3个或更多组件，KillFocus就不会发生至少其中一个，因此，失效也不会发生。我不知道为什么选择TCustomTransparentControl作为祖先，但这就是造成问题的原因。在某些情况下，该控件会使其下的其他控件（窗体）无效，并且由于它应该是透明的，因此不会调用其绘制过程。如果您从TCustomControl继承，If将起作用（至少它对我起作用）。我想要一个透明的控件，TCustomTransparentControl似乎是显而易见的选择。但是我切换到了TCustomControl，并将以另一种方式进行透明度操作。谢谢你的回答，如果我在控件上有两个组件，它就会工作，只要我有3个或更多组件，KillFocus就不会发生至少其中一个，因此，失效也不会发生。我不知道为什么选择TCustomTransparentControl作为祖先，但这就是造成问题的原因。在某些情况下，该控件会使其下的其他控件（窗体）无效，并且由于它应该是透明的，因此不会调用其绘制过程。如果您从TCustomControl继承，If将起作用（至少它对我起作用）。我想要一个透明的控件，TCustomTransparentControl似乎是显而易见的选择。但我切换到了TCustomControl，并将以另一种方式实现透明度