自定义组件释放时出错。

tp机器猫 2012-08-02 05:13:23
刚开始学写组件。
下面的代码,写好安装后。放进一个窗口中。先执行几次add函数。然后执行delete(一次或多次),然后关闭窗口。
这时报错。好像是释放问题。该怎么解决呀.



unit PageCtrolEx;

interface

uses
SysUtils,Classes,Controls,ExtCtrls,Graphics,GraphUtil
,windows;
type
TPageCtrolEx=class;

TTabSheetEX= class(TCustomControl)
private
FGradientStart,FGradientEnd:TColor;
FDirection:TGradientDirection;
FpageCtrl:TPageCtrolEx;


protected
procedure SetParent(AParent: TWinControl); override;
public
constructor create(Aowner:TComponent);override;

destructor Destroy;override;
published

property Caption;
// property align;
end;

TPageCtrolEx = class(TCustomControl)
private
FPageList:TList;

function GetPageCount:Integer;
function GetPages(Index: Integer): TTabSheetEX;
procedure Resize; override;
{ Private declarations }
protected
procedure Paint;override;
{ Protected declarations }
public
constructor create(Aowner:TComponent);override;
destructor Destroy;override;
function Add:TTabSheetEX;
procedure Delete(AIndex:integer);

property PageCount:Integer read GetPageCount;
property Pages[Index: Integer]: TTabSheetEX read GetPages;
{ Public declarations }
published
property color;
{ Published declarations }
end;

Procedure Register;

implementation


Procedure Register;
Begin
RegisterComponents( 'test', [ TPageCtrolEx ] );
End;
{ TPageCtrolEx }

function TPageCtrolEx.Add: TTabSheetEX;
begin
Result:=TTabSheetEX.Create(Self);
OutputDebugString(PChar(IntToStr(FPageList.Count)));
end;

constructor TPageCtrolEx.create(Aowner: TComponent);
begin
inherited Create(Aowner);
FPageList:=TList.Create;
end;

procedure TPageCtrolEx.Delete(AIndex: integer);
var
I: Integer;
begin
if AIndex<FPageList.Count then
begin
for I := 0 to ControlCount - 1 do
begin
if TTabSheetEX(FPageList.Items[AIndex])=Controls[I] then
begin
(Controls[I] as TTabSheetEX).free;
Break;
end;
end;
FPageList.Delete(AIndex);
end;
end;

destructor TPageCtrolEx.Destroy;
var
I: Integer;
j: Integer;
begin
// for I := 0 to FPageList.Count - 1 do
// begin
// for j := 0 to ControlCount - 1 do
// begin
// if Controls[j]=TTabSheetEX(FPageList.Items[I]) then
// begin
// Controls[j].Free;
// Continue;
// end;
// end;
// end;
// FPageList.Free;
inherited;
end;

function TPageCtrolEx.GetPageCount: Integer;
begin
Result:=FPageList.Count;
end;

function TPageCtrolEx.GetPages(Index: Integer): TTabSheetEX;
begin
// TODO -cMM: TPageCtrolEx.GetPages default body inserted
Result := TTabSheetEX(FPageList.Items[index]);
end;

procedure TPageCtrolEx.Paint;
var
I: Integer;
Arect:TRect;
begin
inherited;
arect:=Bounds(0,0,0,0);
for I := 0 to FPageList.Count-1 do
begin
Arect.Left:=Arect.Right+2;
Arect.Top:=1;
Arect.Right:=Arect.Left+50;
Arect.Bottom:=24;
Canvas.Brush.Color:=clWhite;
Canvas.FillRect(Arect);
Canvas.TextOut(Arect.Left+2,3,TTabSheetEX(FPageList.Items[I]).Caption);
TTabSheetEX(FPageList.Items[I]).DrawBackGround ;
end;
end;

procedure TPageCtrolEx.Resize;
var
I: Integer;
begin
inherited;
for I := 0 to FPageList.Count - 1 do
begin
TTabSheetEX(FPageList.Items[I]).Height:=Height-24;
end;
end;

{ TTabSheetEX }
constructor TTabSheetEX.create(Aowner: TComponent);
begin
ControlStyle := [csAcceptsControls];
inherited Create(Aowner); //.Owner
FpageCtrl:=TPageCtrolEx(Aowner);
Parent:=FpageCtrl;
Height:=FpageCtrl.Height-24;
//align:=alBottom;
Name:='Tab'+inttostr(FpageCtrl.FPageList.Count);
FpageCtrl.FPageList.Add(Self);
end;

destructor TTabSheetEX.Destroy;
begin
inherited;
end;


procedure TTabSheetEX.SetParent(AParent: TWinControl);
begin
if AParent <>FpageCtrl then Exit;
inherited;
end;

end.
...全文
81 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
tp机器猫 2012-08-03
  • 打赏
  • 举报
回复
找到了。用removecontrol方法删除。但是在设计时删除子组件时还是会报错。运行时没问题
kaikai_kk 2012-08-03
  • 打赏
  • 举报
回复
Add时没有添加到FPageList
s11ss 2012-08-02
  • 打赏
  • 举报
回复
destructor TPageCtrolEx.Destroy;
里头的
for j := 0 to ControlCount - 1 do
应当改作
for j := ControlCount - 1 downto 0 do

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧