为什么我在尝试实现接口时得到 "Invalid pointer operation"？

Question

我从 here 发布的 David 的回答中获得了这段代码，并适应了我的 Delphi 2009。它是 IDropTarget 界面的一个很好和简单的实现。一切正常，除了当我关闭应用程序时出现 "Invalid pointer operation" 错误。如果删除 Target.Free; 行，我将不再收到错误，但我想这不是解决方案。

我是界面新手，我在网上阅读了一些教程，但我仍然不明白为什么会出现该错误。

DragAndDrop.pas

unit DragAndDrop;

interface

uses
  Windows, ActiveX, ShellAPI, StrUtils, Forms;

type

  TArrayOfString = array of string;

  TDropEvent = procedure(Sender:TObject; FileNames:TArrayOfString) of object;

  TDropTarget = class(TInterfacedObject, IDropTarget)
  private
    FHandle: HWND;
    FOnDrop: TDropEvent;
    FDropAllowed: Boolean;
    procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArrayOfString);
    procedure SetEffect(var dwEffect: Integer);
    function DropAllowed(const FileNames:TArrayOfString): Boolean;

    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;
    property OnDrop:TDropEvent read FOnDrop write FOnDrop;
  end;

implementation

{ TDropTarget }

constructor TDropTarget.Create(AHandle: HWND);
begin
  inherited Create;
  FHandle:=AHandle;
  FOnDrop:=nil;
  RegisterDragDrop(FHandle, Self)
end;

destructor TDropTarget.Destroy;
begin
  RevokeDragDrop(FHandle);
  inherited;
end;

// the rest doesn't matter...

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DragAndDrop, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
   Target:TDropTarget;
   procedure OnFilesDrop(Sender:TObject; FileNames:TArrayOfString);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Target:=TDropTarget.Create(Memo1.Handle);
 Target.OnDrop:=OnFilesDrop;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Target.Free;
end;

procedure TForm1.OnFilesDrop(Sender: TObject; FileNames: TArrayOfString);
var x:Integer;
begin
 for x:=0 to High(FileNames) do
  Memo1.Lines.Add(FileNames[x]);
end;

Answer 1

接口是引用计数的，但是您的 TForm1 没有按照引用计数规则正确运行。更糟糕的是，TDropTarget 假设 HWND 的生命周期将超过 TDropTarget 对象的生命周期，而 VCL 无法保证这一点。只有TMemo知道自己的HWND在程序的生命周期中什么时候有效，什么时候是destroyed/recreated。 TDropTarget 不应该管理自己的注册，TMemo 自己需要管理它。

试试这个：

unit DragAndDrop;

interface

uses
  Windows, ActiveX, ShellAPI, StrUtils;

type

  TArrayOfString = array of string;

  TDropEvent = procedure(FileNames: TArrayOfString) of object;

  TDropTarget = class(TInterfacedObject, IDropTarget)
  private
    FOnDrop: TDropEvent;
    FDropAllowed: Boolean;
    procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArrayOfString);
    procedure SetEffect(var dwEffect: Integer);
    function DropAllowed(const FileNames:TArrayOfString): Boolean;

    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(AOnDrop: TDropEvent);
  end;

implementation

{ TDropTarget }

constructor TDropTarget.Create(AOnDrop: TDropEvent);
begin
  inherited Create;
  FOnDrop := AOnDrop;
end;

// the rest doesn't matter...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DragAndDrop, StdCtrls;

type
  TMemo = class(StdCtrls.TMemo)
  private
    Target: IDropTarget;
    FOnDrop: TDropEvent;
    procedure OnFilesDrop(FileNames: TArrayOfString);
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  public
    property OnDrop: TDropEvent read FOnDrop write FOnDrop;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure OnFilesDrop(FileNames: TArrayOfString);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TMemo.CreateWnd;
begin
  inherited CreateWnd;
  if Target = nil then
    Target := TDropTarget.Create(OnFilesDrop);
  RegisterDragDrop(Handle, Target);
end;

procedure TMemo.DestroyWnd;
begin
  RevokeDragDrop(Handle);
  inherited DestroyWnd;
end;

procedure TMemo.OnFilesDrop(FileNames: TArrayOfString);
begin
  if Assigned(FOnDrop) then FOnDrop(FileNames);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.OnDrop := OnFilesDrop;
end;

procedure TForm1.OnFilesDrop(FileNames: TArrayOfString);
var
  x: Integer;
begin
  for x := Low(FileNames) to High(FileNames) do
    Memo1.Lines.Add(FileNames[x]);
end;

为什么我在尝试实现接口时得到 "Invalid pointer operation"？

Why I'm getting "Invalid pointer operation" when I try to implement an interface?

delphi

interface

delphi-2009