Delphi TWinControl运行时子控件重复问题求助

算力阿峰

2026-7-4

自定义TWinControl组件运行时子控件重复出现的问题

我开发了一个继承自TWinControl的自定义组件TEBSPayments_Test，设计时放到窗体上显示正常，但程序运行时所有子控件会重复出现。排查后发现InitializeComponents方法被调用了两次，但找不到第二次调用的来源。之前粘贴组件到窗体时就出现过重复，当时是因为有两次InitializeComponents调用，现在仅运行时出现该问题，断点显示这个方法被触发两次。

TEBSPayments_Test组件代码

unit Payments_Test;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, AdvSmoothButton, EBSGrid,
   Vcl.StdCtrls, Vcl.ExtCtrls, Data.DB, MemDS, EBS3DataClass,
  DBAccess, AdvUtil, Vcl.Grids, AdvObj, BaseGrid, AdvGrid,AdvStyleIF;

type
  TEBSPayments_Test = class(TWinControl)
  private
    { Private declarations }
    fDeletePayment, fNewPayment : TNotifyEvent;
    PYLabel33: TLabel;
    lblOverPayment: TLabel;
    cmdAddPayment: TAdvSmoothButton;
    cmdDeletePayment: TAdvSmoothButton;
    PYPanel1: TPanel;
    PyGrid1: TEBSGrid;
    FBackgroundColor, FPanelColor: TColor;
    procedure cmdDeletePaymentClick(Sender: TObject);
    procedure cmdAddPaymentClick(Sender: TObject);
    procedure SetBackgroundColor(const Value: TColor);
    procedure SetPanelColor(const Value: TColor);
    procedure InitializeComponents;
  Protected
    procedure SetParent(AParent: TWinControl); override;
  Published
    property Anchors  default [akLeft, akTop];
    property Align  default alNone;
    property AutoSize Default True;
    property PanelColor: TColor read FPanelColor write SetPanelColor default clSkyBlue;
    property BackgroundColor: TColor read FBackgroundColor write 
    SetBackgroundColor default clSkyBlue;
    property DeletePayment: TNotifyEvent read FDeletePayment write FDeletePayment;
    property NewPayment: TNotifyEvent read FNewPayment write FNewPayment;
  public
    { Public declarations }
    procedure Initialise;
    procedure CloseControl;
    constructor Create(AOwner: TComponent); override;
    Destructor Destroy; Override;
  end;

Procedure Register;

implementation

Uses EBS3DataUtils;

procedure TEBSPayments_Test.SetBackgroundColor(const Value: TColor);
begin
  if FBackgroundColor <> Value then
  begin
    FBackgroundColor := Value;
    Color := FBackgroundColor;
  end;
end;

procedure TEBSPayments_Test.SetPanelColor(const Value: TColor);
begin
  if FPanelColor <> Value then
  begin
    FPanelColor := Value;
    Color := FPanelColor;
  end;
end;


constructor TEBSPayments_Test.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 428;
  Height := 224;
end;

procedure TEBSPayments_Test.InitializeComponents;
begin
  PYPanel1 := TPanel.Create(Self);
  PYPanel1.Parent := Self;
  PYPanel1.Height := 22;
  PYPanel1.Align := alTop;
  PYPanel1.Caption := '';
  PyGrid1 := TEBSGrid.Create(Self);
  PYGrid1.Parent := Self;
  PYGrid1.AutoSize := False;
  PYGrid1.Align := alBottom;
  PYGrid1.Height := ClientHeight - PYPanel1.Height;
  PYGrid1.FctlGrid.FixedCols := 0;
  FBackgroundColor := clSkyBlue;
  FPanelColor := clMoneyGreen;
  PYPanel1.Color := FPanelColor;
  Color := FBackgroundColor;
  cmdDeletePayment := TAdvSmoothButton.Create(Self);
  cmdDeletePayment.Parent := PYPanel1;
  cmdDeletePayment.SetBounds(182,1,54,20);
  cmdDeletePayment.UIStyle := tsCustom;
  cmdDeletePayment.Caption := 'Delete';
  cmdDeletePayment.Color := clBlue;
  cmdDeletePayment.Appearance.Font.Color := clWhite;
  cmdDeletePayment.Appearance.Rounding := 8;
  cmdDeletePayment.Bevel := True;
  cmdDeletePayment.BevelColor := clWhite;
  cmdAddPayment := TAdvSmoothButton.Create(Self);
  cmdAddPayment.Parent := PYPanel1;
  cmdAddPayment.SetBounds( 127,1,49,20);
  cmdAddPayment.UIStyle := tsCustom;
  cmdAddPayment.Caption := 'New';
  cmdAddPayment.Color := clBlue;
  cmdAddPayment.Appearance.Font.Color := clWhite;
  cmdAddPayment.Appearance.Rounding := 8;
  cmdAddPayment.Bevel := True;
  cmdAddPayment.BevelColor := clWhite;
  lblOverPayment := TLabel.Create(Self);
  lblOverPayment.Parent := PYPanel1;
  lblOverPayment.SetBounds(483,5,116,13);
  lblOverPayment.Font.Color := clRed;
  lblOverPayment.Font.Style := [fsBold];
  PYLabel33 := TLabel.Create(Self);
  PYLabel33.Parent := PYPanel1;
  PYLabel33.SetBounds(8,6,66,13);
  PYLabel33.Font.Color := clGreen;
  PYLabel33.Font.Style := [fsBold];
end;

procedure TEBSPayments_Test.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if Assigned(AParent) then  InitializeComponents;
end;


Destructor TEBSPayments_Test.Destroy;
begin
  PYLabel33.Free;
  lblOverPayment.Free;
  cmdAddPayment.Free;
  cmdDeletePayment.Free;
  PYPanel1.Free;
  PyGrid1.Free;
  Inherited Destroy;
end;


procedure TEBSPayments_Test.Initialise;
begin
end;

procedure TEBSPayments_Test.CloseControl;
begin
  PYGrid1.SaveGridSettings;
end;

procedure TEBSPayments_Test.cmdAddPaymentClick(Sender: TObject);
begin
  if Assigned(FNewPayment) then
    FNewPayment(Self);
end;

procedure TEBSPayments_Test.cmdDeletePaymentClick(Sender: TObject);
begin
  if Assigned(FDeletePayment) then
    FDeletePayment(Self);
end;


procedure Register;
begin
  RegisterComponents('EBSH', [TEBSPayments_Test]);
end;

end.

测试窗体代码

unit ComponentTest;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, 
  System.Variants, System.Classes,Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,AdvUtil, Vcl.Grids, AdvObj,
  BaseGrid, AdvGrid, UniProvider, SQLServerUniProvider,
   Vcl.StdCtrls,  JvExStdCtrls, JvMemo, Vcl.ExtCtrls,
  Notes, ContactPanel, Payments_Test;

type
  TfrmCompTest = class(TForm)
    Button1: TButton;
    EBSPayments_Test1: TEBSPayments_Test;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCompTest: TfrmCompTest;

implementation

{$R *.dfm}

end.

问题分析与解决方法

核心原因

SetParent方法在程序运行时可能被多次触发：

设计时组件被放到窗体时调用一次；
程序启动加载DFM流时，组件的Parent属性会被再次设置，导致InitializeComponents被第二次调用，重复创建所有子控件。

修复步骤

1. 添加初始化标记，避免重复调用

在组件类的私有段添加布尔变量标记子控件是否已初始化：

private
  // ... 原有代码
  FComponentsInitialized: Boolean;

在构造函数中初始化标记：

constructor TEBSPayments_Test.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 428;
  Height := 224;
  FComponentsInitialized := False;
end;

修改SetParent方法，仅在未初始化且父控件有效时创建子控件：

procedure TEBSPayments_Test.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if Assigned(AParent) and not FComponentsInitialized then
  begin
    InitializeComponents;
    FComponentsInitialized := True;
  end;
end;

2. 标记子控件为非持久化（推荐）

因为子控件是动态创建的，不需要保存到DFM中，给每个子控件添加非持久化标记，避免设计器或DFM流重复处理：

// 在InitializeComponents中创建子控件后添加
PYPanel1.ComponentStyle := PYPanel1.ComponentStyle - [csPersistent];
PyGrid1.ComponentStyle := PyGrid1.ComponentStyle - [csPersistent];
cmdDeletePayment.ComponentStyle := cmdDeletePayment.ComponentStyle - [csPersistent];
cmdAddPayment.ComponentStyle := cmdAddPayment.ComponentStyle - [csPersistent];
lblOverPayment.ComponentStyle := lblOverPayment.ComponentStyle - [csPersistent];
PYLabel33.ComponentStyle := PYLabel33.ComponentStyle - [csPersistent];

3. 优化销毁逻辑（可选）

避免空指针风险，销毁前先判断控件是否存在：

Destructor TEBSPayments_Test.Destroy;
begin
  if Assigned(PYLabel33) then PYLabel33.Free;
  if Assigned(lblOverPayment) then lblOverPayment.Free;
  if Assigned(cmdAddPayment) then cmdAddPayment.Free;
  if Assigned(cmdDeletePayment) then cmdDeletePayment.Free;
  if Assigned(PYPanel1) then PYPanel1.Free;
  if Assigned(PyGrid1) then PyGrid1.Free;
  Inherited Destroy;
end;

替代方案：移到CreateWnd初始化

CreateWnd只会在控件第一次创建窗口句柄时调用一次，可彻底避免重复触发问题。移除SetParent中的初始化代码，改为：

procedure TEBSPayments_Test.CreateWnd;
begin
  inherited CreateWnd;
  if not FComponentsInitialized then
  begin
    InitializeComponents;
    FComponentsInitialized := True;
  end;
end;

内容的提问来源于stack exchange，提问作者Niall Thoresen

Delphi TWinControl运行时子控件重复问题求助

TEBSPayments_Test组件代码 #

测试窗体代码 #

问题分析与解决方法 #

核心原因 #

修复步骤 #