Delphi自定义透明控件消失

Question

我使用 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.

提前感谢您的帮助

Answer 1

您的控件中存在一些错误。

您必须重写 destructor，您必须为 WM_SETFOCUS 和 WM_KILLFOCUS 实现处理程序，您不应该因鼠标单击事件而无效，您应该重写 Click()使用 OnClick，Paint 程序应该使用 Width-1 和 Height-1，不需要覆盖 CreateParams，因为它已经在基础 class.[=19 中完成=]

这是我修改后的固定版本：

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 进行测试。

Delphi自定义透明控件消失

Delphi TCustomTransparentControl dissapears

delphi