Как я могу разрешить формам принимать файлы без обработки сообщений Windows?

В Delphi XE я могу разрешить моей форме принимать «drag and drop» файла, но без необходимости обрабатывать сообщения с общими windowsми?

Вам не нужно обрабатывать сообщения, чтобы реализовать это. Вам просто нужно реализовать IDropTarget и вызвать RegisterDragDrop / RevokeDragDrop . Это действительно очень просто. Фактически вы можете реализовать IDropTarget в коде формы, но я предпочитаю делать это в вспомогательном classе, который выглядит так:

 uses Winapi.Windows, Winapi.ActiveX, Winapi.ShellAPI, System.StrUtils, Vcl.Forms; type IDragDrop = interface function DropAllowed(const FileNames: array of string): Boolean; procedure Drop(const FileNames: array of string); end; TDropTarget = class(TObject, IInterface, IDropTarget) private // IInterface function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; private // IDropTarget FHandle: HWND; FDragDrop: IDragDrop; FDropAllowed: Boolean; procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArray); procedure SetEffect(var dwEffect: Integer); function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): 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; public constructor Create(AHandle: HWND; const ADragDrop: IDragDrop); destructor Destroy; override; end; { TDropTarget } constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop); begin inherited Create; FHandle := AHandle; FDragDrop := ADragDrop; RegisterDragDrop(FHandle, Self) end; destructor TDropTarget.Destroy; begin RevokeDragDrop(FHandle); inherited; end; function TDropTarget.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then begin Result := S_OK; end else begin Result := E_NOINTERFACE; end; end; function TDropTarget._AddRef: Integer; begin Result := -1; end; function TDropTarget._Release: Integer; begin Result := -1; end; procedure TDropTarget.GetFileNames(const dataObj: IDataObject; var FileNames: TArray); var i: Integer; formatetcIn: TFormatEtc; medium: TStgMedium; dropHandle: HDROP; begin FileNames := nil; formatetcIn.cfFormat := CF_HDROP; formatetcIn.ptd := nil; formatetcIn.dwAspect := DVASPECT_CONTENT; formatetcIn.lindex := -1; formatetcIn.tymed := TYMED_HGLOBAL; if dataObj.GetData(formatetcIn, medium)=S_OK then begin (* This cast needed because HDROP is incorrectly declared as Longint in ShellAPI.pas. It should be declared as THandle which is an unsigned integer. Without this fix the routine fails in top-down memory allocation scenarios. *) dropHandle := HDROP(medium.hGlobal); SetLength(FileNames, DragQueryFile(dropHandle, $FFFFFFFF, nil, 0)); for i := 0 to high(FileNames) do begin SetLength(FileNames[i], DragQueryFile(dropHandle, i, nil, 0)); DragQueryFile(dropHandle, i, @FileNames[i][1], Length(FileNames[i])+1); end; end; end; procedure TDropTarget.SetEffect(var dwEffect: Integer); begin if FDropAllowed then begin dwEffect := DROPEFFECT_COPY; end else begin dwEffect := DROPEFFECT_NONE; end; end; function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; var FileNames: TArray; begin Result := S_OK; Try GetFileNames(dataObj, FileNames); FDropAllowed := (Length(FileNames)>0) and FDragDrop.DropAllowed(FileNames); SetEffect(dwEffect); Except Result := E_UNEXPECTED; End; end; function TDropTarget.DragLeave: HResult; begin Result := S_OK; end; function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; begin Result := S_OK; Try SetEffect(dwEffect); Except Result := E_UNEXPECTED; End; end; function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; var FileNames: TArray; begin Result := S_OK; Try GetFileNames(dataObj, FileNames); if Length(FileNames)>0 then begin FDragDrop.Drop(FileNames); end; Except Application.HandleException(Self); End; end; 

Идея здесь заключается в том, чтобы завершить сложность Windows IDropTarget в TDropTarget . Все, что вам нужно сделать, это реализовать IDragDrop который намного проще. Во всяком случае, я думаю, это должно заставить вас идти.

Создайте целевой объект drop из CreateWnd управления CreateWnd . Уничтожьте его в методе DestroyWnd . Этот момент важен, поскольку повторное создание windows VCL означает, что элемент управления может уничтожить и заново создать дескриптор windows в течение его жизненного цикла.

Обратите внимание, что подсчет ссылок на TDropTarget подавляется. Это происходит потому, что, когда вызывается RegisterDragDrop он увеличивает счетчик ссылок. Это создает круговую ссылку и этот код для подавления переходов подсчета ссылок. Это означает, что вы должны использовать этот class через переменную classа, а не переменную интерфейса, чтобы избежать утечки.

Использование будет выглядеть примерно так:

 type TMainForm = class(TForm, IDragDrop) .... private FDropTarget: TDropTarget; // implement IDragDrop function DropAllowed(const FileNames: array of string): Boolean; procedure Drop(const FileNames: array of string); protected procedure CreateWnd; override; procedure DestroyWnd; override; end; .... procedure TMainForm.CreateWnd; begin inherited; FDropTarget := TDropTarget.Create(WindowHandle, Self); end; procedure TMainForm.DestroyWnd; begin FreeAndNil(FDropTarget); inherited; end; function TMainForm.DropAllowed(const FileNames: array of string): Boolean; begin Result := True; end; procedure TMainForm.Drop(const FileNames: array of string); begin ; // do something with the file names end; 

Здесь я использую форму в качестве целевой цели. Но вы можете использовать любой другой оконный элемент управления аналогичным образом.

Если вам не нравится чистый WinAPI, вы можете использовать компоненты. Компонент Drag and Drop Suite бесплатно с источниками.

Нет, если вы не собираетесь пересматривать некоторый пользовательский потомок TForm, который уже имеет эту функциональность.

Я использовал решение Дэвида Хеффернана как базу для своего тестового приложения и получил «Неверную операцию указателя» на закрытии приложения. Решение этой проблемы состояло в том, чтобы изменить TDropTarget.Create, добавив ‘_Release;’

 constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop); begin inherited Create; FHandle := AHandle; FDragDrop := ADragDrop; RegisterDragDrop(FHandle, Self); _Release; end; 

Обсуждение этой проблемы вы можете увидеть на форуме Embarcadero .

Вы должны либо написать код самостоятельно, либо установить сторонний продукт, такой как DropMaster , который позволяет вам перетаскивать и старые версии Delphi.

–jeroen

  • Draggable возвращается, если вне этого div и внутри других draggables (используя как недопустимые, так и действительные варианты возврата)
  • Приложение Swing -> Перетащите на рабочий стол / папку
  • Как использовать Drag-and-Drop в Swing для получения пути к файлу?
  • Перетаскивание на рабочий стол / проводник
  • Как использовать событие jQuery для выгрузки файлов, загруженных с рабочего стола?
  • «dragleave» родительского элемента срабатывает при перетаскивании дочерних элементов
  • Java - Как перетащить JPanel с его компонентами
  • Как установить приоритетный приемник мыши
  • Android Перетаскивание изображений на экране?
  • перетащить файлы в стандартный файл html-файла
  • Как перетащить файлы в приложение?
  • Давайте будем гением компьютера.