Object-oriented: the interface with the object life cycle, the interface is automatically released

Relevant information:

https://www.baidu.com/link?url=yYEHJesIUg6HguekaIW-U0HtjtLn430Dh0NXSc7ej5ixppqcq21rsYMvlCo_qNOP&wd=&eqid=87bf080a00000c50000000035e83f9e4

Example:

An interface unit (UnInterface.pas):

 1 unit UnInterface;
 2 
 3 interface
 4 uses
 5   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 6   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ToolWin, Vcl.ActnMan;
 7 
 8 type
 9   IFormInterface = interface(IInterface)
10   ['{51869234-9F24-4409-A61D-C6A1A47E7E53}']
11   procedure ShowForm stdcall;
12   procedure HideForm stdcall;
13   end;
14 
15   TFormInterface = class(TForm, IInterface, IFormInterface)
16 //  TFormInterface = class(TForm, IFormInterface)
17   private
18     { Private declarations }
19     protected FRefCount: Integer;
20     function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
21     function _AddRef: Integer stdcall;
22     function _Release: Integer stdcall;
23     procedure ShowForm stdcall;
24     procedure HideForm stdcall;
25   public
26     constructor Create(AOwner: TComponent); override;
27 
28     procedure AfterConstruction; override;
29     procedure BeforeDestruction; override;
30     class function NewInstance: TObject; override;
31   property RefCount: Integer read FRefCount;
32   end;
33 
34 implementation
35 
36 
37 procedure TFormInterface.AfterConstruction;
38 begin
39   InterlockedDecrement(FRefCount);
40 end;
41 
42 procedure TFormInterface.BeforeDestruction;
43 begin
44   if RefCount <> 0 then
45   raise EInvalidPointer.Create('Invalid ptr');
46 end;
47 
48 constructor TFormInterface.Create(AOwner: TComponent);
49 begin
50   inherited CreateNew(AOwner);
51 end;
52 
53 function TFormInterface._AddRef: Integer;
54 begin
55   Result := InterlockedIncrement(FRefCount);
56 end;
57 
58 function TFormInterface._Release: Integer;
59 begin
60   Result := InterlockedDecrement(FRefCount);
61   if Result = 0 then
62   Destroy;
63 end;
64 
65 class function TFormInterface.NewInstance: TObject;
66 begin
67   Result := inherited NewInstance;
68   TFormInterface(Result).FRefCount := 1;
69 end;
70 
71 function TFormInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
72 begin
73   if GetInterface(IID, Obj) then
74   Result := 0
75   else
76   Result := E_NOINTERFACE;
77 end;
78 
79 procedure TFormInterface.HideForm;
80 begin
81   Hide;
82 end;
83 
84 procedure TFormInterface.ShowForm;
85 begin
86   Show;
87 end;
88 
89 end.
View Code

 

Calling unit (Unit1.pas):

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ToolWin, Vcl.ActnMan,
 8   IdGlobal,
 9   UnShare,
10   UnInterface;
11 
12 type
13   TForm1 = class(TForm)
14     Button1: TButton;
15   procedure Button1Click(Sender: TObject);
16   private
17     {Declarations Private } 
18 is      FIForm: IFormInterface;
 . 19    public 
20 is      { Public Declarations } 
21 is    End ;
 22 is  
23 is  var 
24    the Form1: TForm1;
 25  
26 is  Implementation 
27  { $ R & lt *. Dfm } 
28  
29  Procedure TForm1.Button1Click (Sender: TObject);
 30  var 
31 is    IForm: IFormInterface;
 32  the begin 
33 is  //   run the program, press Button1, you will see a window appears, which disappears after 2 seconds, thus achieving automatic release function 
34  //  IForm: = TFormInterface.Create (nil) AS IFormInterface; 
35  //   iForm.ShowForm; 
36  //   Sleep (2000); 
37 [  //   define a member variable in Form1, a IFormInterface type interface, the object can be maintained to when the program exits, Form1 is released automatically released when 
38  //   written TFormInterface.Create (Self), then problems will release 
39    IForm: = TFormInterface. the Create ( nil ) AS IFormInterface;
 40    iForm.ShowForm;
 41 is    FIForm: = IForm;
 42 is  End ;
 43 is  End .
View Code

 

Guess you like

Origin www.cnblogs.com/FKdelphi/p/12612159.html