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;