| Цитата |
маленько не то что надо
|
Именно так. Реализую интерфейс для Drag&Drop. По сути для задачи сабжа нужно реализовать THDropDataObject.GetDataHere но как это сделать (и то ли это) - вопрос открытый. Подскажите про сабж, пожалуйста. | Код |
unit DragDrop;
interface
uses Windows, ActiveX, Classes, FileDrop;
type
{ TFileDropSource - èñòî÷íèê
äëÿ ïåðåòàñêèâàíèÿ ôàéëîâ }
TFileDropSource = class (TInterfacedObject,
IDropSource)
constructor Create;
function QueryContinueDrag
(fEscapePressed: BOOL;
grfKeyState: Longint): HResult; stdcall;
function GiveFeedback(dwEffect: Longint):
HResult; stdcall;
end;
{ THDropDataObject - îáúåêò äàííûõ ñ
èíôîðìàöèåé î ïåðåòàñêèâàåìûõ ôàéëàõ }
THDropDataObject = class(TInterfacedObject,
IDataObject)
private
FDropInfo : TDragDropInfo;
public
constructor Create(ADropPoint : TPoint;
AInClient : Boolean);
destructor Destroy; override;
procedure Add (const s : String);
{ èç 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;
implementation
uses EnumFmt;
{ TFileDropSource }
constructor TFileDropSource.Create;
begin
inherited Create;
_AddRef;
end;
{
QueryContinueDrag îïðåäåëÿåò
íåîáõîäèìûå äåéñòâèÿ. Ôóíêöèÿ ïðåäïîëàãàåò,
÷òî äëÿ ïåðåòàñêèâàíèÿ èñïîëüçóåòñÿ
òîëüêî ëåâàÿ êíîïêà ìûøè.
}
function TFileDropSource.QueryContinueDrag
(
fEscapePressed: BOOL;
grfKeyState: Longint
): HResult;
begin
if (fEscapePressed) 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 TFileDropSource.GiveFeedback
(
dwEffect: Longint
): HResult;
begin
case dwEffect of
DROPEFFECT_NONE,
DROPEFFECT_COPY,
// DROPEFFECT_MOVE,
DROPEFFECT_LINK,
DROPEFFECT_SCROLL : Result :=
DRAGDROP_S_USEDEFAULTCURSORS;
else
Result := S_OK;
end;
end;
{ THDropDataObject }
constructor THDropDataObject.Create
(
ADropPoint : TPoint;
AInClient : Boolean
);
begin
inherited Create;
_AddRef;
FDropInfo := TDragDropInfo.Create
(ADropPoint, AInClient);
end;
destructor THDropDataObject.Destroy;
begin
if (FDropInfo <> nil) then
FDropInfo.Free;
inherited Destroy;
end;
procedure THDropDataObject.Add
(
const s : String
);
begin
FDropInfo.Add (s);
end;
function THDropDataObject.GetData
(
const formatetcIn: TFormatEtc;
out medium: TStgMedium
): HResult;
begin
Result := DV_E_FORMATETC;
{ Íåîáõîäèìî îáíóëèòü âñå ïîëÿ medium
íà ñëó÷àé îøèáêè}
medium.tymed := 0;
medium.hGlobal := 0;
medium.unkForRelease := nil;
{ Åñëè ôîðìàò ïîääåðæèâàåòñÿ, ñîçäàåì
è âîçâðàùàåì äàííûå }
if (QueryGetData (formatetcIn) = S_OK) then
begin
if (FDropInfo <> nil) then
begin
medium.tymed := TYMED_HGLOBAL;
{ Çà îñâîáîæäåíèå îòâå÷àåò
âûçûâàþùàÿ ñòîðîíà! }
medium.hGlobal := FDropInfo.CreateHDrop;
Result := S_OK;
end;
end;
end;
function THDropDataObject.GetDataHere
(
const formatetc: TFormatEtc;
out medium: TStgMedium
): HResult;
begin
Result := DV_E_FORMATETC; { Ê ñîæàëåíèþ,
íå ïîääåðæèâàåòñÿ }
end;
function THDropDataObject.QueryGetData
(
const formatetc: TFormatEtc
): HResult;
begin
Result := DV_E_FORMATETC;
with formatetc do
if dwAspect = DVASPECT_CONTENT then
if (cfFormat = CF_HDROP) and (tymed =
TYMED_HGLOBAL) then
Result := S_OK;
end;
function THDropDataObject.GetCanonicalFormatEtc
(
const formatetc: TFormatEtc;
out formatetcOut: TFormatEtc
): HResult;
begin
formatetcOut.ptd := nil;
Result := E_NOTIMPL;
end;
function THDropDataObject.SetData
(
const formatetc: TFormatEtc;
var medium: TStgMedium;
fRelease: BOOL
): HResult;
begin
Result := E_NOTIMPL;
end;
{ EnumFormatEtc âîçâðàùàåò ñïèñîê
ïîääåðæèâàåìûõ ôîðìàòîâ }
function THDropDataObject.EnumFormatEtc
(
dwDirection: Longint;
out enumFormatEtc:
IEnumFormatEtc
): HResult;
const
DataFormats: array [0..0] of TFormatEtc =
(
(
cfFormat : CF_HDROP;
ptd : Nil;
dwAspect : DVASPECT_CONTENT;
lindex : -1;
tymed : TYMED_HGLOBAL;
)
);
DataFormatCount = 1;
begin
{ Ïîääåðæèâàåòñÿ òîëüêî Get. Çàäàòü
ñîäåðæèìîå äàííûõ íåëüçÿ }
if dwDirection = DATADIR_GET then
begin
enumFormatEtc := TEnumFormatEtc.Create
(@DataFormats, DataFormatCount, 0);
Result := S_OK;
end else
begin
enumFormatEtc := nil;
Result := E_NOTIMPL;
end;
end;
{ Ôóíêöèè Advise íå ïîääåðæèâàþòñÿ }
function THDropDataObject.DAdvise
(
const formatetc: TFormatEtc;
advf: Longint;
const advSink: IAdviseSink;
out dwConnection: Longint
): HResult;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function THDropDataObject.DUnadvise
(
dwConnection: Longint
): HResult;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function THDropDataObject.EnumDAdvise
(
out enumAdvise: IEnumStatData
): HResult;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
initialization
OleInitialize (Nil);
finalization
OleUninitialize;
end.
|
|
Drag&Drop, полупрозрачное изображение под курсором 
Дата 11.10.2004, 22:48 (
Загрузка ...
