Почему экземпляр класса (TInterfacedObject, IDropTarget) не авто-бесплатный?

Question

Я реализации моей IDropTarget на основе: How can I allow a form to accept file dropping without handling Windows messages?

implementation Дэвид прекрасно работает. однако объект IDropTarget (TInterfacedObject) не автообновлен, даже если он установлен на «ноль».

Часть кода:

{ TDropTarget } 
constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop); 
begin 
    inherited Create; 
    FHandle := AHandle; 
    FDragDrop := ADragDrop; 
    OleCheck(RegisterDragDrop(FHandle, Self)); 
    //_Release; 
end; 

destructor TDropTarget.Destroy; 
begin 
    MessageBox(0, 'TDropTarget.Destroy', '', MB_TASKMODAL); 
    RevokeDragDrop(FHandle); 
    inherited; 
end; 
... 

procedure TForm1.FormShow(Sender: TObject); 
begin 
    Assert(Panel1.HandleAllocated); 
    FDropTarget := TDropTarget.Create(Panel1.Handle, nil) as IDropTarget; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    FDropTarget := nil; // This should free FDropTarget 
end; 

var 
    NeedOleUninitialize: Boolean = False; 

initialization 
    NeedOleUninitialize := Succeeded(OleInitialize(nil)); 

finalization 
    if (NeedOleUninitialize) then 
    OleUninitialize; 

end. 

где FDropTarget: IDropTarget;.

Когда я нажимаю кнопку, отображается сообщение MessageBox и объект не уничтожается.

Если я называю _Release;as suggested here в конце конструктора, FDropTarget разрушается при нажатии на кнопку или, когда программа завершает работу (у меня есть сомнения по поводу этого «решения»).

Если я опустил RegisterDragDrop(FHandle, Self), то FDropTarget разрушен, как ожидалось.

Я думаю, что подсчет ссылок по какой-либо причине нарушен. Я действительно смущен. Как я могу правильно сделать TInterfacedObject?

---

EDIT:

Вот полный код:

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
    VirtualTrees, ExtCtrls, StdCtrls, 
    ActiveX, ComObj; 

type  
    TDropTarget = class(TInterfacedObject, IDropTarget) 
    private 
    FHandle: HWND; 
    FDropAllowed: Boolean; 
    function GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree; 
    procedure SetEffect(var dwEffect: Integer); 
    function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; stdcall; 
    function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; 
    function DragLeave: HResult; stdcall; 
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; 
    public 
    constructor Create(AHandle: HWND); 
    destructor Destroy; override; 
    end; 

    TForm1 = class(TForm) 
    Panel1: TPanel; 
    VirtualStringTree1: TVirtualStringTree; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree; 
     Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); 
    procedure Button1Click(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    private 
    FDropTarget: IDropTarget; 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.DFM} 

{ TDropTarget } 

constructor TDropTarget.Create(AHandle: HWND); 
begin 
    inherited Create; 
    FHandle := AHandle; 
    OleCheck(RegisterDragDrop(FHandle, Self)); 
    //_Release; 
end; 

destructor TDropTarget.Destroy; 
begin 
    MessageBox(0, 'TDropTarget.Destroy', '', MB_TASKMODAL); 
    RevokeDragDrop(FHandle); 
    inherited; 
end; 

function TDropTarget.GetTreeFromDataObject(const DataObject: IDataObject): TBaseVirtualTree; 
// Returns the owner/sender of the given data object by means of a special clipboard format 
// or nil if the sender is in another process or no virtual tree at all. 
var 
    Medium: TStgMedium; 
    Data: PVTReference; 
    formatetcIn: TFormatEtc; 
begin 
    Result := nil; 
    if Assigned(DataObject) then 
    begin 
    formatetcIn.cfFormat := CF_VTREFERENCE; 
    formatetcIn.ptd := nil; 
    formatetcIn.dwAspect := DVASPECT_CONTENT; 
    formatetcIn.lindex := -1; 
    formatetcIn.tymed := TYMED_ISTREAM or TYMED_HGLOBAL; 
    if DataObject.GetData(formatetcIn, Medium) = S_OK then 
    begin 
     Data := GlobalLock(Medium.hGlobal); 
     if Assigned(Data) then 
     begin 
     if Data.Process = GetCurrentProcessID then 
      Result := Data.Tree; 
     GlobalUnlock(Medium.hGlobal); 
     end; 
     ReleaseStgMedium(Medium); 
    end; 
    end; 
end; 

procedure TDropTarget.SetEffect(var dwEffect: Integer); 
begin 
    if FDropAllowed then begin 
    dwEffect := DROPEFFECT_COPY; 
    end else begin 
    dwEffect := DROPEFFECT_NONE; 
    end; 
end; 

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
var 
    Tree: TBaseVirtualTree; 
begin 
    Result := S_OK; 
    try 
    Tree := GetTreeFromDataObject(dataObj); 
    FDropAllowed := Assigned(Tree); 
    SetEffect(dwEffect); 
    except 
    Result := E_UNEXPECTED; 
    end; 
end; 

function TDropTarget.DragLeave: HResult; 
begin 
    Result := S_OK; 
end; 

function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
begin 
    Result := S_OK; 
    try 
    SetEffect(dwEffect); 
    except 
    Result := E_UNEXPECTED; 
    end; 
end; 

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; 
var 
    Tree: TBaseVirtualTree; 
begin 
    Result := S_OK; 
    try 
    Tree := GetTreeFromDataObject(dataObj); 
    FDropAllowed := Assigned(Tree); 
    if FDropAllowed then 
    begin 
     Alert(Tree.Name); 
    end; 
    except 
    Application.HandleException(Self); 
    end; 
end; 

{----------------------------------------------------------------------------------------------------------------------} 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
    VirtualStringTree1.RootNodeCount := 10; 
end; 

procedure TForm1.VirtualStringTree1DragAllowed(Sender: TBaseVirtualTree; 
    Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); 
begin 
    Allowed := True; 
end; 

procedure TForm1.FormShow(Sender: TObject); 
begin 
    Assert(Panel1.HandleAllocated); 
    FDropTarget := TDropTarget.Create(Panel1.Handle) as IDropTarget; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    FDropTarget := nil; // This should free FDropTarget 
end; 

var 
    NeedOleUninitialize: Boolean = False; 

initialization 
    NeedOleUninitialize := Succeeded(OleInitialize(nil)); 

finalization 
    if (NeedOleUninitialize) then 
    OleUninitialize; 

end. 

DFM:

object Form1: TForm1 
    Left = 192 
    Top = 114 
    Width = 567 
    Height = 268 
    Caption = 'Form1' 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'MS Shell Dlg 2' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    OnShow = FormShow 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Panel1: TPanel 
    Left = 368 
    Top = 8 
    Width = 185 
    Height = 73 
    Caption = 'Panel1' 
    TabOrder = 0 
    end 
    object VirtualStringTree1: TVirtualStringTree 
    Left = 8 
    Top = 8 
    Width = 200 
    Height = 217 
    Header.AutoSizeIndex = 0 
    Header.Font.Charset = DEFAULT_CHARSET 
    Header.Font.Color = clWindowText 
    Header.Font.Height = -11 
    Header.Font.Name = 'MS Shell Dlg 2' 
    Header.Font.Style = [] 
    Header.MainColumn = -1 
    Header.Options = [hoColumnResize, hoDrag] 
    TabOrder = 1 
    TreeOptions.SelectionOptions = [toMultiSelect] 
    OnDragAllowed = VirtualStringTree1DragAllowed 
    Columns = <> 
    end 
    object Button1: TButton 
    Left = 280 
    Top = 8 
    Width = 75 
    Height = 25 
    Caption = 'Button1' 
    TabOrder = 2 
    OnClick = Button1Click 
    end 
end 

---

Вывод: From the docs:

RegisterDragDrop функция также вызывает метод IUnknown :: AddRef на указатель IDropTarget

Код в the answer I linked был зафиксирован.

Обратите внимание, что ссылка, указывающая на TDropTarget, подавляется. То есть , потому что, когда вызывается RegisterDragDrop, он увеличивает счетчик . Это создает циклическую ссылку и этот код для подавления ссылок на разрывы ссылок. Это означает, что вы использовали бы этот класс через переменную класса, а не переменную интерфейса, в , чтобы избежать утечки.

Answer 1

Вызов RegisterDragDrop в TDragDrop.Create передает подсчитанное ссылку на экземпляр нового экземпляра TDragDrop. Это увеличивает его счетчик ссылок. Инструкция FDragDrop := Nil уменьшает опорный счетчик, но по-прежнему существует ссылка на объект, который препятствует уничтожению объекта. Вам необходимо позвонить RevokeDragDrop(FHandle)до, вы удалите последнюю ссылку на этот экземпляр, чтобы получить контрольный счетчик до нуля.

Вкратце: вызывать RevokeDragDrop внутри деструктора слишком поздно.