Реализация класса
{
FILEDROP.PAS -- реализация простейшего приемника OLE.
Автор: Джим Мишель
Дата последней редакции: 28/05/97
} unit FileDrop; interface uses Windows, ActiveX, Classes; type { TDragDropInfo слегка изменился по сравнению с FMDD2.PAS } TDragDropInfo = class (TObject) private FInClientArea : Boolean; FDropPoint : TPoint; FFileList : TStringList; public constructor Create (ADropPoint : TPoint; AInClient : Boolean);
destructor Destroy; override; procedure Add (const s : String);
property InClientArea : Boolean read FInClientArea; property DropPoint : TPoint read FDropPoint; property Files : TStringList read FFileList; end; TFileDropEvent = procedure (DDI : TDragDropInfo) of object; { TFileDropTarget знает, как принимать сброшенные файлы } TFileDropTarget = class (TInterfacedObject, IDropTarget) private FHandle : HWND; FOnFilesDropped : TFileDropEvent; public constructor Create (Handle: HWND; AOnDrop: TFileDropEvent);
destructor Destroy; override; { из IDropTarget } function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint) : HResult; stdcall; function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; function DragLeave: HResult; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall; property OnFilesDropped : TFileDropEvent read FOnFilesDropped write FOnFilesDropped; end; implementation uses ShellAPI; { TDragDropInfo } constructor TDragDropInfo.Create ( ADropPoint : TPoint; AInClient : Boolean );
begin inherited Create; FFileList := TStringList.Create; FDropPoint := ADropPoint; FInClientArea := AInClient; end; destructor TDragDropInfo.Destroy; begin FFileList.Free; inherited Destroy; end; procedure TDragDropInfo.Add ( const s : String );
begin Files.Add (s);
end; { TFileDropTarget } constructor TFileDropTarget.Create ( Handle: HWND; AOnDrop: TFileDropEvent );
begin inherited Create; _AddRef; FHandle := Handle; FOnFilesDropped := AOnDrop; ActiveX.CoLockObjectExternal(Self, true, false);
ActiveX.RegisterDragDrop (FHandle, Self);
end; { Destroy снимает блокировку с объекта и разрывает связь с ним } destructor TFileDropTarget.Destroy; var WorkHandle: HWND; begin { Если значение FHandle не равно 0, значит, связь с окном все еще существует. Обратите внимание на то, что FHandle необходимо прежде всего присвоить 0, потому что CoLockObjectExternal и RevokeDragDrop вызывают Release, что, в свою очередь, может привести к вызову Free и зацикливанию программы. Подозреваю, что этот фрагмент не совсем надежен. Если объект будет освобожден до того, как счетчик ссылок упадет до 0, может возникнуть исключение. } if (FHandle <>
0) then begin WorkHandle := FHandle; FHandle := 0; ActiveX.CoLockObjectExternal (Self, false, true);
ActiveX.RevokeDragDrop (WorkHandle);
end; inherited Destroy; end; function TFileDropTarget.DragEnter ( const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; begin dwEffect := DROPEFFECT_COPY; Result := S_OK; end; function TFileDropTarget.DragOver ( grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; begin dwEffect := DROPEFFECT_COPY; Result := S_OK; end; function TFileDropTarget.DragLeave: HResult; stdcall; begin Result := S_OK; end; { Обработка сброшенных данных. } function TFileDropTarget.Drop ( const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint ): HResult; stdcall; var Medium : TSTGMedium; Format : TFormatETC; NumFiles: Integer; i : Integer; rslt : Integer; DropInfo : TDragDropInfo; szFilename : array [0..MAX_PATH] of char; InClient : Boolean; DropPoint : TPoint; begin dataObj._AddRef; { Получаем данные. Структура TFormatETC сообщает dataObj.GetData, как получить данные и в каком формате они должны храниться (эта информация содержится в структуре TSTGMedium). } Format.cfFormat := CF_HDROP; Format.ptd := Nil; Format.dwAspect := DVASPECT_CONTENT; Format.lindex := -1; Format.tymed := TYMED_HGLOBAL; { Заносим данные в структуру Medium } rslt := dataObj.GetData (Format, Medium);
{ Если все прошло успешно, далее действуем, как при операции файлового перетаскивания FMDD. } if (rslt = S_OK) then begin { Получаем количество файлов и прочие сведения } NumFiles := DragQueryFile (Medium.hGlobal, $FFFFFFFF, NIL, 0);
InClient := DragQueryPoint (Medium.hGlobal, DropPoint);
{ Создаем объект TDragDropInfo } DropInfo := TDragDropInfo.Create (DropPoint, InClient);
{ Заносим все файлы в список } for i := 0 to NumFiles - 1 do begin DragQueryFile (Medium.hGlobal, i, szFilename, sizeof(szFilename));
DropInfo.Add (szFilename);
end; { Если указан обработчик, вызываем его } if (Assigned (FOnFilesDropped)) then begin FOnFilesDropped (DropInfo);
end; DropInfo.Free; end; if (Medium.unkForRelease = nil) then ReleaseStgMedium (Medium);
dataObj._Release; dwEffect := DROPEFFECT_COPY; result := S_OK; end; initialization OleInitialize (Nil);
finalization OleUninitialize; end.
Обратите внимание на то, что функции OleInitialize и OleUninitialize вызываются соответственно в секциях initialization и finalization данного модуля. Тем самым мы гарантируем, что библиотеки OLE будут инициализи рованы до первого обращения к ним из модуля и деинициализированы лишь после того, как работа с ними будет закончена.
Перед тем как переходить к подробному обсуждению реализации, давайте построим простейшую форму, в которой прием сброшенных данных организован с помощью объекта TOleDropTarget. Эта форма во многом похожа на остальные примеры, использованные в предыдущей главе. На ней присутствует всего один компонент — список, на который можно сбрасывать файлы из Windows Explorer. В листинге 4.2 содержатся методы этой формы.