拖放文件--从应用程序往外拖放文件

API是DoDragDrop但你要用IDataObject接口自己建立个对象把文件信息存在IDataObject接口里IDataObject还有些指定过程要你完成
GetData
GetDataHere
QueryGetData
GetCanonicalFormatEtc
SetData
EnumFormatEtc
DAdvise
EnumDAdvise

郁闷，要那么多手续的啊？SonicX(SonicX)，能否给个代码示例？？

而且我们已经知道了那张图片的路径了，似乎只是用drop和drag动作实现移动或剪切效果就行了吧？

代码在这里
http://community.csdn.net/Expert/topic/5328/5328765.xml?temp=.6787683

整理出来了unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, ComObj, ActiveX, ShlObj;type
  TForm1 = class(TForm)
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;  TDrop = class(TInterfacedObject,IDropSource,IDataObject,IEnumFormatEtc)
   FIndex: Word ;
  public
   procedure free;
   //IDropSource
   function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
   function GiveFeedback(dwEffect: Longint): HResult; stdcall;
   //IEnumFormatEtc
   function AddFormat(Enum: TFormatEtc): Integer;
   function Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
   function Skip(celt: Longint): HResult; stdcall;
   function Reset: HResult; stdcall;
   function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
   //IDataObject
   function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
   function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
   function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
   function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;stdcall;
   function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
   function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
   function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
   function DUnadvise(dwConnection: Longint): HResult; stdcall;
   function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  end;
var
  Form1: TForm1;implementation{$R *.dfm}
//IDropSource
function TDrop.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
begin
  if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then begin
    Result := DRAGDROP_S_CANCEL;
  end else if grfKeyState and MK_LBUTTON = 0 then begin
    Result := DRAGDROP_S_DROP;
  end else begin
    Result := S_OK;
  end
end;function TDrop.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;//IEnumFormatEtc
function TDrop.AddFormat(Enum: TFormatEtc): Integer;
begin
Result := -1;
end;function TDrop.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
begin
Result := S_FALSE;
if celt=0 then Reset;
if FIndex>0 then exit;
with TFormatEtc(elt) do begin
    cfFormat := CF_HDROP;
    tymed    := TYMED_HGLOBAL;
    dwAspect := DVASPECT_CONTENT;
    lIndex   := 0;
    ptd      := nil;
end;
if Assigned(pceltFetched) then pceltFetched^:=FIndex; if celt>0 then Inc(FIndex,celt) else inc(FIndex);
Result := S_OK;
end;function TDrop.Skip(celt: Longint): HResult; stdcall;
begin Result := S_FALSE  end;function TDrop.Reset: HResult; stdcall;
begin
FIndex:=0;
Result := S_OK;
end;function TDrop.Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
begin  Result := E_NOTIMPL; end; //不支持的接口//IDataObject
function TDrop.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
var
BufferText : String;
pGlobal    : Pointer;
i          : Integer;
begin
Result := DV_E_FORMATETC; //不支持的格式
if not (Self.QueryGetData(formatetcIn)=S_OK) then exit;
   FillChar(Medium,Sizeof(TStgMedium),0);
   Medium.tymed:=formatetcIn.tymed;   BufferText:=Form1.FileListBox1.Directory+'\';
   for i:=0 to Form1.FileListBox1.Count - 1 do
     if Form1.FileListBox1.Selected[i] then begin
       BufferText:=BufferText+Form1.FileListBox1.Items[i]+#0+#0;
       break;
     end;
   //需要拖拽多个文件的格式如下
   //'c:\temp\aa.txt'+#0+#0+'c:\temp\aa.txt'+#0+#0;+'c:\temp\aa.txt'+#0+#0;
   Medium.hGlobal := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or  GMEM_SHARE, Length(BufferText)+1+Sizeof(TDropFiles));
   pGlobal := GlobalLock(Medium.hGlobal);
   PDropFiles(pGlobal)^.pFiles:=Sizeof(TDropFiles);
   PDropFiles(pGlobal)^.pt:=Point(0,0);
   PDropFiles(pGlobal)^.fNC:=False;
   PDropFiles(pGlobal)^.fWide:=False;
   inc(Longword(pGlobal),Sizeof(TDropFiles)); //指针后移
   CopyMemory(PGlobal,Pchar(BufferText),Length(BufferText)+1);
   GlobalUnlock(Medium.hGlobal);
   Medium.unkForRelease := nil;
   Result := S_OK;
end;
function TDrop.QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
begin
Result := DV_E_FORMATETC; //不支持的格式 if (formatetc.cfFormat=CF_HDROP) and  //表示支持文件拖拽格式
    (formatetc.tymed=TYMED_HGLOBAL) and
    (formatetc.dwAspect=DVASPECT_CONTENT) then
     Result := S_OK;
end;function TDrop.EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
begin
Result := S_FALSE;
Reset;
case dwDirection of
   DATADIR_GET :
          begin
            enumFormatEtc:=Self as IEnumFormatEtc;
            Result := S_OK;
          end;
   DATADIR_SET : Result := E_NOTIMPL;
end;
end;function TDrop.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}function TDrop.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}function TDrop.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}function TDrop.DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}function TDrop.DUnadvise(dwConnection: Longint): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}function TDrop.EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
begin Result := E_NOTIMPL; end; //不支持的接口}procedure TDrop.free;
begin
end;procedure TForm1.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Effect    : Longint;
DataObject: TDrop;
begin
if not (Button=mbLeft) then exit;
DataObject:=TDrop.Create;
Effect := DROPEFFECT_NONE;
OleCheck(DoDragDrop(DataObject as IDataObject, DataObject as IDropSource, DROPEFFECT_COPY, Effect));
DataObject.Free;
end;initialization
  OleInitialize(nil);
finalization
  OleUninitialize;

代码编译通过，但FileListBox里的东西拖动不了到桌面....

不可能吧
我在delphi7+winxp sp2测试通过

文件格式没有限制（只要存在），FileListBox1中当鼠标左键按下开始拖拽，另外你步进查下TDrop.GetData中BufferText最后格式化的文件路径是否正确
unit1.dfmobject Form1: TForm1
  Left = 317
  Top = 179
  Width = 321
  Height = 188
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object FileListBox1: TFileListBox
    Left = 166
    Top = 8
    Width = 131
    Height = 129
    ItemHeight = 13
    TabOrder = 0
    OnMouseDown = FileListBox1MouseDown
  end
  object DirectoryListBox1: TDirectoryListBox
    Left = 16
    Top = 8
    Width = 145
    Height = 97
    FileList = FileListBox1
    ItemHeight = 16
    TabOrder = 1
  end
  object DriveComboBox1: TDriveComboBox
    Left = 16
    Top = 112
    Width = 145
    Height = 19
    DirList = DirectoryListBox1
    TabOrder = 2
  end
end

调试易

拖放文件--从应用程序往外拖放文件

解决方案 »