uses
DropSource;
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i : integer;
D : TDropFileSource;
begin
if (Listview1.SelCount = 0) then
exit;
D := TDropFileSource.Create(Self);
D.Files.Clear;
for i := 0 to Listview1.Items.Count - 1 do
if (Listview1.items.Item.Selected) then
D.Files.Add(Listview1.items.Item.Caption); //添加文件名
D.Execute;
D.Free();
end;
//////////////////////////DropSource.pas//////////////////////////////
unit DropSource;
interface
uses
Controls, Windows, ActiveX, Classes, CommCtrl;
type
TInterfacedComponent = class(TComponent, IUnknown)
private
fRefCount: Integer;
protected
function QueryInterface(const IID: TGuid; out Obj): HRESULT; override; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
TDragType = (dtCopy, dtMove, dtLink);
TDragTypes = set of TDragType;
TDropSource = class(TInterfacedComponent, IDropSource, IDataObject)
private
fDragTypes: TDragTypes;
protected
FeedbackEffect: LongInt;
// IDropSource implementation
function QueryContinueDrag(fEscapePressed: bool; grfKeyState: LongInt): HRESULT; stdcall;
function GiveFeedback(dwEffect: LongInt): HRESULT; stdcall;
// IDataObject implementation
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;
//New functions...
function DoGetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HRESULT; virtual; abstract;
public
constructor Create(aowner: TComponent); override;
function Execute: HRESULT;
published
property Dragtypes: TDragTypes read fDragTypes write fDragTypes;
end;
TDropFileSource = class(TDropSource)
private
fFiles: TStrings;
procedure SetFiles(files: TStrings);
protected
function DoGetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HRESULT; override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
property Files: TStrings read fFiles write SetFiles;
end;
procedure Register;
implementation
uses
ShlObj, SysUtils, ClipBrd;
procedure Register;
begin
RegisterComponents('DragDrop', [TDropFileSource]);
end;
function TInterfacedComponent.QueryInterface(const IID: TGuid; out Obj): HRESULT;
begin
if GetInterface(IID, Obj) then
result := 0
else
result := E_NOINTERFACE;
end;
function TInterfacedComponent._AddRef: Integer;
begin
result := InterlockedIncrement(fRefCount);
end;
function TInterfacedComponent._Release: Integer;
begin
Result := InterlockedDecrement(fRefCount);
if (Result = 0) then Free;
end;
// -----------------------------------------------------------------------------
// TEnumFormatEtc
// -----------------------------------------------------------------------------
type
TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
private
fFormatList: TFormatEtc;
fIndex: Integer;
public
constructor Create;
{ IEnumFormatEtc }
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;
end;
constructor TEnumFormatEtc.Create;
begin
inherited Create;
fFormatList.cfFormat := CF_HDROP;
fFormatList.ptd := nil;
fFormatList.dwAspect := DVASPECT_CONTENT;
fFormatList.lIndex := -1;
fFormatList.tymed := TYMED_HGLOBAL;
fIndex := 0;
end;
function TEnumFormatEtc.Next(Celt: LongInt; out Elt; pCeltFetched: pLongInt): HRESULT;
begin
TFormatEtc(Elt) := fFormatList;
if (fIndex = 0) then
result := S_OK
else
result := S_FALSE;
fIndex := 1;
end;
function TEnumFormatEtc.Skip(Celt: LongInt): HRESULT;
begin
result := S_FALSE;
end;
function TEnumFormatEtc.ReSet: HRESULT;
begin
fIndex := 0;
result := S_OK;
end;
function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HRESULT;
begin
result := S_OK;
end;
// -----------------------------------------------------------------------------
// TDropSource
// -----------------------------------------------------------------------------
constructor TDropSource.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
DragTypes := [dtCopy];
_AddRef;
end;
function TDropSource.GiveFeedback(dwEffect: LongInt): HRESULT; stdcall;
begin
FeedbackEffect := dwEffect;
result := DRAGDROP_S_USEDEFAULTCURSORS
end;
function TDropSource.GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcout: TFormatEtc): HRESULT;
begin
result := DATA_S_SAMEFORMATETC;
end;
function TDropSource.SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium;
fRelease: Bool): HRESULT;
begin
result := E_NOTIMPL;
end;
function TDropSource.DAdvise(const FormatEtc: TFormatEtc; advf: LongInt;
const advSink: IAdviseSink; out dwConnection: LongInt): HRESULT;
begin
result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDropSource.DUnadvise(dwConnection: LongInt): HRESULT;
begin
result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDropSource.EnumDAdvise(out EnumAdvise: IEnumStatData): HRESULT;
begin
result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDropSource.GetData(const FormatEtcIn: TFormatEtc;
out Medium: TStgMedium): HRESULT; stdcall;
begin
result := DoGetData(FormatEtcIn, Medium);
end;
function TDropSource.GetDataHere(const FormatEtc: TFormatEtc;
out Medium: TStgMedium): HRESULT; stdcall;
begin
result := E_NOTIMPL;
end;
function TDropSource.QueryGetData(const FormatEtc: TFormatEtc): HRESULT; stdcall;
begin
if (FormatEtc.cfFormat = CF_HDROP) and
(FormatEtc.dwAspect = DVASPECT_CONTENT) and
(FormatEtc.tymed and TYMED_HGLOBAL <> 0) then
result := S_OK
else
result := E_FAIL;
end;
function TDropSource.EnumFormatEtc(dwDirection: LongInt;
out EnumFormatEtc: IEnumFormatEtc): HRESULT; stdcall;
begin
if (dwDirection = DATADIR_GET) then
begin
EnumFormatEtc := TEnumFormatEtc.Create;
result := S_OK;
end
else
if (dwDirection = DATADIR_SET) then
result := E_NOTIMPL
else
result := E_INVALIDARG;
end;
// -----------------------------------------------------------------------------
function TDropSource.QueryContinueDrag(fEscapePressed: bool;
grfKeyState: LongInt): HRESULT; stdcall;
var
ContinueDrop : Boolean;
dragtype : TDragType;
begin
if fEscapePressed then
result := DRAGDROP_S_CANCEL
// will now allow drag and drop with either mouse button.
else
if (grfKeyState = 0) then
begin
ContinueDrop := true;
DragType := dtCopy;
if (FeedbackEffect and DROPEFFECT_COPY <> 0) then
DragType := dtCopy
else
if (FeedbackEffect and DROPEFFECT_MOVE <> 0) then
dragtype := dtMove
else
if (FeedbackEffect and DROPEFFECT_LINK <> 0) then dragtype := dtLink;
if not (DragType in dragtypes) then ContinueDrop := False;
if ContinueDrop then
result := DRAGDROP_S_DROP
else
result := DRAGDROP_S_CANCEL;
end
else
result := NOERROR;
end;
// -----------------------------------------------------------------------------
function TDropSource.Execute: HRESULT;
var
okeffect, effect : longint;
begin
okeffect := DROPEFFECT_NONE;
if (dtCopy in fDragTypes) then okeffect := okeffect or DROPEFFECT_COPY;
if (dtMove in fDragTypes) then okeffect := okeffect or DROPEFFECT_MOVE;
if (dtLink in fDragTypes) then okeffect := okeffect or DROPEFFECT_LINK;
result := DoDragDrop(Self as IDataObject, Self as IDropSource, okeffect, effect);
end;
// -----------------------------------------------------------------------------
// TDropFileSource
// -----------------------------------------------------------------------------
constructor TDropFileSource.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
fFiles := TStringList.Create;
end;
// -----------------------------------------------------------------------------
destructor TDropFileSource.destroy;
begin
fFiles.Free;
inherited Destroy;
end;
// -----------------------------------------------------------------------------
procedure TDropFileSource.SetFiles(files: TStrings);
begin
fFiles.assign(files);
end;
// -----------------------------------------------------------------------------
function TDropFileSource.DoGetData(const FormatEtcIn: TFormatEtc;
out Medium: TStgMedium): HRESULT;
var
i : Integer;
dropfiles : pDropFiles;
pFile : PChar;
strlength : Integer;
begin
Medium.tymed := 0;
Medium.UnkForRelease := nil;
Medium.hGlobal := 0;
if fFiles.count = 0 then
result := E_UNEXPECTED
//--------------------------------------------------------------------------
else
if (FormatEtcIn.cfFormat = CF_HDROP) and
(FormatEtcIn.dwAspect = DVASPECT_CONTENT) and
(FormatEtcIn.tymed and TYMED_HGLOBAL <> 0) then
begin
strlength := 0;
for i := 0 to fFiles.Count - 1 do
Inc(strlength, Length(fFiles) + 1);
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles) + strlength + 1);
if (Medium.hGlobal = 0) then
result := E_OUTOFMEMORY
else
begin
Medium.tymed := TYMED_HGLOBAL;
dropfiles := GlobalLock(Medium.hGlobal);
try
dropfiles^.pfiles := SizeOf(TDropFiles);
dropfiles^.fwide := False;
longint(pFile) := longint(dropfiles) + SizeOf(TDropFiles);
for i := 0 to fFiles.Count - 1 do
begin
StrPCopy(pFile, fFiles);
Inc(pFile, Length(fFiles) + 1);
end;
pFile^ := #0;
finally
GlobalUnlock(Medium.hGlobal);
end;
result := S_OK;
end;
end
else
result := DV_E_FORMATETC;
end;
// -----------------------------------------------------------------------------
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
