delphi - How to make my file DropSouce be accepted by all targets that works with files? -


i made control represents list of files , want able drag files control other applications work files. implemented idragsource interface (as shown below) when drag, files accepted windows explorer, other applications firefox, yahoo messenger, photoshop... not accept files. have done wrong ? have feeling idataobject not set correctly , i'm afraid have implemet myself... , coplicated job me because started work interfaces.

here code reproduce problem:

unit unit1;  interface  uses   windows, messages, sysutils, variants, classes, graphics, controls, forms,   dialogs, stdctrls, activex, shlobj;  type   tmycontrol = class(tmemo, idropsource)   private    function querycontinuedrag(fescapepressed:bool; grfkeystate:longint):hresult; stdcall;    function givefeedback(dweffect:longint):hresult; stdcall;    procedure dodraganddrop;    function getfilelistdataobject:idataobject;   protected    procedure mousemove(shift:tshiftstate; x,y:integer); override;   end;    tform1 = class(tform)     procedure formcreate(sender: tobject);   public     mymemo:tmycontrol;   end;  var   form1: tform1;  implementation  {$r *.dfm}  {tmycontrol}  function tmycontrol.querycontinuedrag(fescapepressed:bool; grfkeystate:longint):hresult; begin  if fescapepressed result:=dragdrop_s_cancel   else if (grfkeystate , (mk_lbutton or mk_rbutton) = 0) result:=dragdrop_s_drop    else result:=s_ok; end;  function tmycontrol.givefeedback(dweffect:longint):hresult; begin  result:=dragdrop_s_usedefaultcursors; end;  procedure tmycontrol.dodraganddrop; var allowedeffects,dropeffect:longint;     dataobj:idataobject; begin  allowedeffects:=dropeffect_copy;  dataobj:=getfilelistdataobject;  if dataobj <> nil   dodragdrop(dataobj, self, allowedeffects, dropeffect); end;  function tmycontrol.getfilelistdataobject:idataobject; var desktop:ishellfolder;     attr,eaten:ulong;     count,x:integer;     pidls:array of pitemidlist; begin  result:=nil;  count:=lines.count;  if count<1 exit;  if failed(shgetdesktopfolder(desktop)) exit;  setlength(pidls,count);  x:=0 count-1 pidls[x]:=nil;  try   x:=0 count-1    if failed(desktop.parsedisplayname(0, nil, pwidechar(lines[x]), eaten, pidls[x], attr)) exit;   desktop.getuiobjectof(0, count, pidls[0], idataobject, nil, result);    x:=0 count-1    if pidls[x]<>nil cotaskmemfree(pidls[x]);  end; end;  procedure tmycontrol.mousemove(shift:tshiftstate; x,y:integer); begin  if ssleft in shift dodraganddrop;  inherited; end;  //---------------------------------  procedure tform1.formcreate(sender: tobject); begin  mymemo:=tmycontrol.create(form1);  mymemo.parent:=form1;  mymemo.align:=alclient; end;  end. 

the problem use incorrect call of desktop.getuiobjectof. when call somefolder.getuiobjectof items must childs of somefolder. in case not true. try this:

type   ppitemidlist = ^pitemidlist;  function getfilelistdataobject(aparentwnd: hwnd; const apath: string; afilenames: tstrings): idataobject; var   desktop: ishellfolder;   eaten, attr: ulong;   i: integer;   pathidlist: pitemidlist;   pathshellfolder: ishellfolder;   idlists: ppitemidlist;   idlistssize: integer;   pos: ppitemidlist; begin   result := nil;   if afilenames.count < 1 exit;    if failed(shgetdesktopfolder(desktop)) exit;   try     attr := 0;     if failed(desktop.parsedisplayname(aparentwnd, nil, pwidechar(apath), eaten, pathidlist, attr)) exit;     try       if failed(desktop.bindtostorage(pathidlist, nil, ishellfolder, pathshellfolder)) exit;       try         idlistssize := sizeof(pitemidlist) * afilenames.count;         getmem(idlists, idlistssize);         try           zeromemory(idlists, idlistssize);           pos := idlists;           := 0 afilenames.count - 1             begin               attr := 0;               if failed(pathshellfolder.parsedisplayname(0, nil, pwidechar(afilenames[i]), eaten, pos^, attr)) exit;               inc(pos);             end;           pathshellfolder.getuiobjectof(0, afilenames.count, idlists^, idataobject, nil, result);                   pos := idlists;           := 0 afilenames.count - 1             begin               if assigned(pos^)                 cotaskmemfree(pos^);               inc(pos);             end;           freemem(idlists);         end;               pathshellfolder := nil;       end;           cotaskmemfree(pathidlist);     end;       desktop := nil;   end; end; 

Comments

Popular posts from this blog

java - Andrioid studio start fail: Fatal error initializing 'null' -

android - Gradle sync Error:Configuration with name 'default' not found -

StringGrid issue in Delphi XE8 firemonkey mobile app -