delphi - 为什么当我尝试实现接口(interface)时收到 "Invalid pointer operation"？

Question

我从大卫发布的答案中得到了这个代码here我适应了 Delphi 2009。这是 IDropTarget 接口(interface)的一个很好且简单的实现。一切正常，除了当我关闭应用程序时出现“无效指针操作”错误。如果我删除 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

接口(interface)进行了引用计数，但您的 TForm1 未正确按照引用计数规则进行播放。更糟糕的是，TDropTarget 假设 HWND 的生命周期将比 TDropTarget 对象的生命周期长，但在VCL。只有 TMemo 知道其自己的 HWND 何时有效，以及在程序的生命周期内何时被销毁/重新创建。 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;