那些遇到过的问题

为什么类的实例(TInterfacedObject,IDropTarget)不能自动释放？

zig*_*zig 6 delphi delphi-5 tinterfacedobject

我正在实现我的IDropTarget基础:如何在不处理Windows消息的情况下允许表单接受文件丢弃？

David 的实施工作正常.但是IDropTarget(TInterfacedObject)对象不会自动释放,即使设置为'nil'也不会.

部分代码是:

{ 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.
Run Code Online (Sandbox Code Playgroud)

哪里FDropTarget: IDropTarget;.

单击按钮时,不会显示MessageBox,也不会销毁对象.

如果我在构造函数的末尾_Release; 按照建议调用,FDropTarget当我单击按钮或程序终止时会被销毁(我对这个"解决方案"有疑问).

如果我省略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.
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

结论: 来自文档:

RegisterDragDrop 函数还调用IDropTarget指针上的IUnknown :: AddRef方法

我链接的答案中的代码是固定的.

请注意,TDropTarget上的引用计数被抑制.这是因为当调用RegisterDragDrop时,它会增加引用计数.这会创建一个循环引用,这个代码可以抑制引用计数.这意味着您将通过类变量而不是接口变量来使用此类,以避免泄漏.

Wos*_*osi 8

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

简而言之:RevokeDragDrop在析构函数内调用为时已晚.

  • 好的,我现在已经这样做了.这个答案可以接受.它将受益于@zig找到的文档的链接. (2认同)

归档时间：

查看次数：

534 次

最近记录：

8 年，7 月 前
如何在不处理Windows消息的情况下允许表单接受文件丢弃？ 17
更多相关链接
相关归档
TMainMenu中的透明PNG图像(带有TImageList) 14
Delphi w Indy 10:idHTTPRequest POST总是HTTP 1.0,如何使它成为HTTP 1.1？ 6
打开文件管理并获取选定的文件 6
有什么方法可以加速TPNGImage上的SaveToStream？ 6
将Delphi字符串作为参数发送到DLL 5
Delphi VCL中的Bug拖放？ 5
在Delphi中定位组件的提示 5
设置TDBGrid可见行 5
使用Button OnClick将值输入到TEdit中 5
检查字符是否包含在char数组中的最佳方法 4
难疑归档
使用JavaScript获取当前网址？ 2882
如何在JavaScript中获取查询字符串值？ 2701
npm install的--save选项是什么？ 1779
Python中的switch语句的替换？ 1719
<快于<=？ 1508
Python的隐藏功能 1419
为什么Java有瞬态字段？ 1406
Apache Camel究竟是什么？ 1310
Android Studio中的Gradle是什么？ 1257
如何从主机获取Docker容器的IP地址？ 1221