张
张鸿林
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
ITest=interface
['{FB71ACDC-F240-11D9-8395-9C5CE63B7910}']
end;
TTest=class(TInterfacedObject,ITest) //继承自TInterfacedObject,可以自动释放
public
constructor Create;
destructor Destroy;override;
end;
TTest1=class(TComponent,ITest) //继承自TComponent,好像不能自动释放
public
constructor Create (AOwner:TComponent)
override;
destructor Destroy;override;
end;
TForm1 = class(TForm)
CreateTest: TButton;
ReleaseTest: TButton;
CreateTest1: TButton;
ReleaseTest1: TButton;
procedure CreateTestClick(Sender: TObject);
procedure ReleaseTestClick(Sender: TObject);
procedure CreateTest1Click(Sender: TObject);
procedure ReleaseTest1Click(Sender: TObject);
private
{ Private declarations }
FTest:ITest;
FTest1:ITest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateTestClick(Sender: TObject);
begin
FTest:=TTest.Create;
end;
procedure TForm1.ReleaseTestClick(Sender: TObject);
begin
FTest._Release;
end;
{ TTest }
constructor TTest.Create;
begin
inherited;
showmessage('create');
end;
destructor TTest.Destroy;
begin
showmessage('Free')
// TTest.Destroy触发
inherited;
end;
{ TTest1 }
constructor TTest1.Create(AOwner:TComponent);
begin
inherited;
showmessage('create');
end;
destructor TTest1.Destroy;
begin
showmessage('Free');
inherited;
end;
procedure TForm1.CreateTest1Click(Sender: TObject);
begin
FTest1:=TTest1.Create(nil);
end;
procedure TForm1.ReleaseTest1Click(Sender: TObject);
begin
FTest1._Release
// TTest1.Destroy没有触发
end;
end.
//察看vcl发现,两个_release的工作方式不一样:
function TInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
ITest=interface
['{FB71ACDC-F240-11D9-8395-9C5CE63B7910}']
end;
TTest=class(TInterfacedObject,ITest) //继承自TInterfacedObject,可以自动释放
public
constructor Create;
destructor Destroy;override;
end;
TTest1=class(TComponent,ITest) //继承自TComponent,好像不能自动释放
public
constructor Create (AOwner:TComponent)
override;
destructor Destroy;override;
end;
TForm1 = class(TForm)
CreateTest: TButton;
ReleaseTest: TButton;
CreateTest1: TButton;
ReleaseTest1: TButton;
procedure CreateTestClick(Sender: TObject);
procedure ReleaseTestClick(Sender: TObject);
procedure CreateTest1Click(Sender: TObject);
procedure ReleaseTest1Click(Sender: TObject);
private
{ Private declarations }
FTest:ITest;
FTest1:ITest;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateTestClick(Sender: TObject);
begin
FTest:=TTest.Create;
end;
procedure TForm1.ReleaseTestClick(Sender: TObject);
begin
FTest._Release;
end;
{ TTest }
constructor TTest.Create;
begin
inherited;
showmessage('create');
end;
destructor TTest.Destroy;
begin
showmessage('Free')
// TTest.Destroy触发
inherited;
end;
{ TTest1 }
constructor TTest1.Create(AOwner:TComponent);
begin
inherited;
showmessage('create');
end;
destructor TTest1.Destroy;
begin
showmessage('Free');
inherited;
end;
procedure TForm1.CreateTest1Click(Sender: TObject);
begin
FTest1:=TTest1.Create(nil);
end;
procedure TForm1.ReleaseTest1Click(Sender: TObject);
begin
FTest1._Release
// TTest1.Destroy没有触发
end;
end.
//察看vcl发现,两个_release的工作方式不一样:
function TInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
function TComponent._Release: Integer;
begin
if FVCLComObject = nil then
Result := -1 // -1 indicates no reference counting is taking place
else
Result := IVCLComObject(FVCLComObject)._Release;
end;