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.

感谢提前提供的帮助

控件中存在许多错误。

必须重写destructor,必须实现WM_SETFOCUSWM_KILLFOCUS的处理程序,不应因鼠标单击事件而无效,应重写Click()而不是使用OnClick,Paint过程应使用Width-1Height-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进行测试。

最新更新