Yes, I have tried the OnDragover and OnMouseOver Events. No, they are not
triggered.
Now my question is this: Is this possible with DragAcceptFiles? (and if so,
how?) or Do I have to go over to the Shell COM API- RegisterDragDrop and
IDropTarget? (and is there demo code for this?)
l8r
Anthony
No
> or Do I have to go over to the Shell COM API- RegisterDragDrop and
> IDropTarget? (and is there demo code for this?)
That's the way to go. You can find a sample at http://www.melander.dk.
Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitly requested!
>
> That's the way to go. You can find a sample at http://www.melander.dk.
>
Google pointed me at other samples, and I kinda answered my own question
here
The Com method does work with a bit of coding, but there is help available.
The tutorials are here http://www.undu.com/Articles/980803b.html and
http://www.undu.com/Articles/980915a.html
There is sample code over here http://www.undu.com/Articles/980916c.html by
Thorsten Engler
And as Peter Below said, a full (free) kit at
http://www.melander.dk/delphi/dragdrop/
My own expansion of the UNDU sample code is as below. It is cooler in that
1) It works on a frame as well as a form
2) It accepts text from explorer or a snippet of Text from WordPad, MS Word,
et al.
unit frDrop;
{ AFS 16 May - code After DropForm.pas code sample from www.undu.com Oct 98
Original code by Thorsten Engler - Thorste...@gmx.net
This frame will accept shell drag/drops as normal delphi drag/drops
}
interface
uses
{ delphi }
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{ Drop } DropTarget;
type
TFrameDrop = class(TFrame)
private
FDropInterface : TTeDropInterface;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
end;
implementation
{$R *.DFM}
constructor TFrameDrop.Create(AOwner: TComponent);
begin
FDropInterface := TTeDropInterface.Create(Self);
inherited;
end;
procedure TFrameDrop.CreateWnd;
begin
inherited;
FDropInterface.DropTarget_Create;
end;
destructor TFrameDrop.Destroy;
begin
inherited;
FreeAndNil(FDropInterface); // before
end;
procedure TFrameDrop.DestroyWnd;
begin
FDropInterface.DropTarget_Destroy;
inherited;
end;
end.
unit Unit2;
{ AFS 16 May 2K
Demo frame that inherits from base class TFrameDrop and
can accept dropped files and text
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
frDrop, ComCtrls;
type
TFrameDrop2 = class(TFrameDrop)
TreeView1: TTreeView;
procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrameDrop2: TFrameDrop2;
implementation
uses
{ Delphi } ActiveX, ComObj, ShellAPI,
{ local } DropTarget;
{$R *.DFM}
{ find a formatEtc in the IDataObject with the specified type }
function GetFormat(const pciData: IDataObject; const piFormatId: integer;
var prFormatEtc: TFormatEtc): Boolean;
var
hRes: integer;
lciEnum: IEnumFormatEtc;
lrFormatEtc: TFormatEtc;
liReturned: integer;
begin
Assert(pciData <> nil);
Result := False;
hRes := pciData.EnumFormatEtc(DATADIR_GET, lciEnum);
OleCheck(hRes);
Assert(lciEnum <> nil);
lciEnum.Reset;
{ loop through all the records }
while True do
begin
{ EOF? }
if lciEnum.Next(1, lrFormatEtc, @liReturned) <> S_OK then
break;
{ use this one? }
if lrFormatEtc.cfFormat = piFormatId then
begin
prFormatEtc := lrFormatEtc;
Result := True;
break;
end;
end;
end;
function GetFileFormat(const pciData: IDataObject; var prFormatEtc:
TFormatEtc): Boolean;
begin
Result := GetFormat(pciData, CF_HDROP, prFormatEtc);
end;
function GetTextFormat(const pciData: IDataObject; var prFormatEtc:
TFormatEtc): Boolean;
begin
Result := GetFormat(pciData, CF_TEXT, prFormatEtc);
end;
procedure ProcessFileMedium(const lrMedium: TStgMedium);
const
cnMaxFileNameLen = 255;
cnMINUSONE = $FFFFFFFF;
var
lgHandle: THandle;
nCount, i: integer;
acFileName : array [0..cnMaxFileNameLen] of char;
begin
lgHandle := lrMedium.hGlobal;
if lgHandle = 0 then
exit;
GlobalLock (lgHandle);
try
nCount := DragQueryFile(lgHandle,
cnMINUSONE, acFileName, cnMaxFileNameLen);
// query Windows one at a time for the file name
for i := 0 to nCount-1 do
begin
DragQueryFile(lgHandle, i, acFileName, cnMaxFileNameLen);
// do your thing with the acFileName
ShowMessage(acFileName);
end;
// let Windows know that you're done
DragFinish(lgHandle);
finally
GlobalUnLock (lgHandle);
end;
end;
procedure ProcessTextMedium(const lrMedium: TStgMedium);
const
cnMaxFileNameLen = 255;
cnMINUSONE = $FFFFFFFF;
var
lgHandle: THandle;
lpChar: PChar;
ls: string;
begin
lgHandle := lrMedium.hGlobal;
if lgHandle = 0 then
exit;
lpChar := GlobalLock (lgHandle);
try
ls := lpChar;
finally
GlobalUnLock (lgHandle);
end;
// do your thing with the text
ShowMessage(ls);
end;
procedure TFrameDrop2.TreeView1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
lcNode: TTreeNode;
begin
inherited;
{ test / demo Only mary can accept }
lcNode := TreeView1.GetNodeAt(X,Y);
Accept := (lcNode <> nil) and (lcNode.Text = 'mary');
end;
procedure TFrameDrop2.TreeView1DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
lciData: IDataObject;
lrFormatEtc: TFormatEtc;
lrMedium: TStgMedium;
begin
inherited;
if not (Source is TTeComDragObject) then
exit;
{ get the interface }
lciData := (Source as TTeComDragObject).DataObject;
Assert(lciData <> nil);
{ OK, if you want to understand this, pay attention
Windows gives you an interface (IDataObject)
from which you can get an interface (IEnumFormatEtc)
which can give you the format records (TFormatEtc)
one of which will may be the file format
and one of which may be a text format
For files:
pass the format to IDataObject.GetData
to get a structure (TStgMedium)
which contains a global handle that you can pass
to a function (DragQueryFile) to find out how many and what file names
you got
For text:
pass the format to IDataObject.GetData
to get the text
Windows API...making it easy
}
if GetFileFormat(lciData, lrFormatEtc) then
begin
if Succeeded (lciData.GetData (lrFormatEtc, lrMedium)) then
ProcessFileMedium(lrMedium);
end
else if GetTextFormat(lciData, lrFormatEtc) then
begin
if Succeeded (lciData.GetData (lrFormatEtc, lrMedium)) then
ProcessTextMedium(lrMedium);
end;
// else there is no format dropped that we can use
end;
end.