Question

我从David发布的here答案中得到了这段代码，并且我适应了我的Delphi 2009.它是IDropTarget界面的一个简单实现。一切正常，除了当我关闭应用程序时我得到了＆＃34;无效的指针操作＆＃34;错误。如果我删除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何时有效以及何时在程序的生命周期内销毁/重新创建它。 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;

为什么我得到＆＃34;指针操作无效＆＃34;当我尝试实现一个接口？

1 个答案: