我正在实现我的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.
哪里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.
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
结论: 来自文档:
RegisterDragDrop函数还调用IDropTarget指针上的IUnknown :: AddRef方法
我链接的答案中的代码是固定的.
请注意,TDropTarget上的引用计数被抑制.这是因为当调用RegisterDragDrop时,它会增加引用计数.这会创建一个循环引用,这个代码可以抑制引用计数.这意味着您将通过类变量而不是接口变量来使用此类,以避免泄漏.
Wosi.. 8
对RegisterDragDropin 的调用TDragDrop.Create将计数引用传递给新实例的实例TDragDrop.这增加了它的参考计数器.该指令FDragDrop := Nil减少了引用计数器,但仍然存在对生命的引用,该引用阻止对象自行销毁.您需要RevokeDragDrop(FHandle) 在删除对该实例的最后一个引用之前调用,以便将引用计数器降至零.
简而言之:RevokeDragDrop在析构函数内调用为时已晚.
对RegisterDragDropin 的调用TDragDrop.Create将计数引用传递给新实例的实例TDragDrop.这增加了它的参考计数器.该指令FDragDrop := Nil减少了引用计数器,但仍然存在对生命的引用,该引用阻止对象自行销毁.您需要RevokeDragDrop(FHandle) 在删除对该实例的最后一个引用之前调用,以便将引用计数器降至零.
简而言之:RevokeDragDrop在析构函数内调用为时已晚.
京公网安备 11010802040832号 | 京ICP备19059560号-6 