拖放文件-从应用程序往外拖放文件解决方案

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

环境:一个窗体,一个Image控件,其中Image里加载了一张知道具体路径的图片

请问,如何编程实现把Image里的那张图片拖放到电脑的任意位置   ??

谢谢...


PS:今天3.8,就给38分,希望各位达人不要嫌少.....

[解决办法]
整理出来了

unit Unit1;

interface

uses
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;