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

Question

I got this code from the David's answer posted here and I adapted to my Delphi 2009. It's a nice and simple implementation of IDropTarget interface. Everything works fine, except that when I close the application I got "Invalid pointer operation" error. If I delete the Target.Free; line I no longer receive the error, but I guess that this is not the solution.

I am new to interfaces, I read some tutorials on the internet but I still can't understang why I'm getting that error.

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

Interfaces are reference counted, but your TForm1 is not playing by the reference counting rules correctly. And worse, TDropTarget is making an assumption that the lifetime of the HWND will outlive the lifetime of the TDropTarget object, and that is not guaranteed in VCL. Only TMemo knows when its own HWND is valid and when it is destroyed/recreated during the lifetime of the program. TDropTarget should not be managing its own registration, TMemo itself needs to manage that instead.

Try this:

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;