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

Ответ 1

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

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<string>);
    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<string>);
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<string>;
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<string>;
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, что намного проще. Во всяком случае, я думаю, это должно заставить вас идти.

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

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

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

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;

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

Ответ 2

Если вам не нравится чистый WinAPI, вы можете использовать компоненты. Перетащить компонентный пакет бесплатно с помощью источников.

Ответ 3

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

Ответ 4

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

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

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

Ответ 5

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

- Йерун