在运行时错误Delphi中创建自定义TPanel

Question

我创建了一个'TPanel'派生类的实例，其中包含一些修改其边界的代码，如下所示：

type
TMyCustuomPanel=class(TPanel)
private
procedure SetBounds(Aleft, Atop, Awidth, Aheight:Integer);override;
end;
...
procedure TMyCustuomPanel.SetBounds(Aleft, Atop, Awidth, Aheight: Integer);
var
Hr:HRGN;
begin
inherited;
Hr := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight, 20, 20);  // <= Error occurs here
SetWindowRgn(Handle,Hr,true) ;
end;

然后我试着创建下一个：

procedure TForm1.Button1Click(Sender: TObject);
var
Frm:TMyCustuomPanel;
begin
frm:=TMyCustuomPanel.Create(self);
Frm.Parent:=Self;
Frm.Name:='Frm01';
Frm.Width:=200;
Frm.Height:=250;
Frm.Color:=clRed;
end;

但我得到错误"控件"没有父窗口">。

谢谢你的帮助。

Delphi 7 Win 7

Answer 1

您的代码中有两个问题：

• CreateRoundRectRgn的调用需要有一个句柄才能工作(实际上需要句柄的是ClientWidth和CLientHeight(。如果在分配句柄之前调用了SetBounds，则可以绕过该调用
• 根据文档，CreateRoundRectRgn创建的区域在不再需要时需要删除

这是修复的代码：

unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TMyCustuomPanel=class(TPanel)
private
FHr : HRGN;
public
destructor Destroy; override;
procedure SetBounds(Aleft,Atop,Awidth,Aheight:Integer); override;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TMyCustuomPanel }
destructor TMyCustuomPanel.Destroy;
begin
if FHr <> 0 then begin
DeleteObject(FHr);
FHr := 0;
end;
inherited;
end;
procedure TMyCustuomPanel.SetBounds(Aleft, Atop, Awidth, Aheight: Integer);
begin
inherited;
if HandleAllocated then begin
if FHr <> 0 then
DeleteObject(FHr);
FHr := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight, 20, 20);
SetWindowRgn(Handle, FHr, TRUE);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Frm:TMyCustuomPanel;
begin
frm                  := TMyCustuomPanel.Create(Self);
Frm.Parent           := Self;
Frm.Name             := 'Frm01';
Frm.Width            := 200;
Frm.Height           := 250;
Frm.ParentColor      := FALSE;   // Remove for old Delphi version
Frm.ParentBackground := FALSE;   // Remove for old Delphi version
Frm.Color            := clRed;
end;
end.

注意：我已经用D10.4.2进行了测试，因为我没有更多的Delphi 7可供测试。ParentColor和ParentBackground属性可能还不存在。如果编译器抱怨，只需删除受影响的行。