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

Question

我创建了一个 'TPanel' derived class 的实例，其中包含一些代码来修改其边框，如下所示：

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;

但我收到错误 'Control '' has no parent window'....

感谢您的帮助。

Delphi 7 胜 7

Answer 1

你的代码有两个问题：

CreateRoundRectRgn的调用需要有句柄才能起作用（实际上是ClientWidth和CLientHeight需要句柄）。如果在分配句柄之前调用 SetBounds，您可以绕过调用。
根据 documentation，由 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 属性还不存在。如果编译器抱怨，只需删除受影响的行。

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

Creating Custom TPanel in run Time Error Delphi

delphi-7

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

Creating Custom TPanel in run Time Error Delphi

delphi-7

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