为什么类的实例（TInterfacedObject，IDropTarget）不能自动释放？

时间：2017-01-19 12:44:37

标签： delphi delphi-5 tinterfacedobject

我根据How can I allow a form to accept file dropping without handling Windows messages?

实施我的IDropTarget

David的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（我对此有疑问＆＃34;溶液＆＃34;。）

如果我省略RegisterDragDrop(FHandle, Self)，则FDropTarget将按预期销毁。

我认为引用计数因某种原因被破坏了。我真的很困惑。如何正确使TInterfacedObject免费？

修改

以下是完整的代码：

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时，它会增加引用   计数。这会创建一个循环引用并禁止此代码   引用计数打破了。这意味着你会使用它   class通过类变量而不是接口变量in   为了避免泄漏。

1 个答案:

答案 0 :(得分：8)

TDragDrop.Create中对RegisterDragDrop的调用将计数引用传递给新TDragDrop实例的实例。这增加了它的参考计数器。指令FDragDrop := Nil减少了引用计数器，但仍然存在对生存对象的引用，该对象阻止对象自行销毁。 您需要在之前调用RevokeDragDrop(FHandle) ，删除对该实例的最后一次引用，以便将参考计数器降至零。

简而言之：在析构函数中调用RevokeDragDrop为时已晚。

相关问题
最新问题