unit fMain;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls;
type
TObjectPtr = ^TObject;
IMyInterface = interface(IUnknown)
end;
TMyInterfacedObject = class(TInterfacedObject, IMyInterface)
private var
FObjectPtrs: array [0..0] of TObjectPtr;
public
constructor Create(var aObj: TObject);
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure TestAnonymProc(aProc: TProc);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TMyInterfacedObject }
constructor TMyInterfacedObject.Create(var aObj: TObject);
begin
FObjectPtrs[0] := @TObject( aObj );
TObject( aObj ) := nil;
end;
destructor TMyInterfacedObject.Destroy;
begin
if Assigned( FObjectPtrs[0]^) then
begin
FObjectPtrs[0]^.Free; // <==
AV
FObjectPtrs[0]^ := nil;
end;
inherited;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
intf: IMyInterface;
list: TStringList;
begin
intf := TMyInterfacedObject.Create( TObject(list) );
list := TStringList.Create;
list.Add( 'Item1' );
TestAnonymProc(
procedure
begin
list.Add( 'Item2' )
end
);
list.Add( 'Item3' );
end;
procedure TForm1.TestAnonymProc(aProc: TProc);
begin
aProc();
end;
end.