На этом шаге мы рассмотрим OLE-реализацию метода drag-and-drop (реализацию контейнера).

Любое приложение, которое работает с документами, обязано принимать сообщение Windows WM_DROPFILES. Обработка этого события позволяет узнать, какие файлы были выбраны пользователем в Windows Explorer (Проводнике) и, если файлы имеют подходящий формат, открыть их как документы. Оно вызывается при перетаскивании файла из Windows Explorer на форму, в которой предварительно был вызван метод ShellAPI DragAcceptFiles. Однако реализовать этот метод можно и через СОМ-интерфейсы. Главное преимущество такой реализации drag-and-drop заключается в том, что содержимое выбранных файлов можно проанализировать до того, как будет отпущена кнопка мыши, и поместить разрешающий (или запрещающий) курсор на контейнер.

Для реализации метода drag-and-drop необходимо создать интерфейс IDropTarget. Его реализация приведена ниже:

unit FileDrop;

interface

uses Windows,ActiveX,Classes;
type
    TFileDropEvent=procedure(Sender:TObject;const FileList:TStringList) of object;
    TFileAcceptEvent=procedure(Sender:TObject;const FileList:TStringList;
        var CanAccept:boolean) of object;
    TFileDropAcceptor=class(TInterfacedObject,IDropTarget)
   private
      FFileList:TStringList;
      FOnFilesDropped:TFileDropEvent;
      FOnFileAccept:TFileAcceptEvent;
   public
      constructor Create(AOnDrop:TFileDropEvent;AOnEnter:TFileAcceptEvent);
      destructor Destroy;override;
      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;

constructor TFileDropAcceptor.Create(AOnDrop:TFileDropEvent;
    AOnEnter:TFileAcceptEvent);
begin
     inherited Create;
     FFileList:=TStringList.Create;
     FOnFilesDropped:=AOnDrop;
     FOnFileAccept:=AOnEnter;
end;

destructor TFileDropAcceptor.Destroy;
begin
     FFileList.Free;
     inherited Destroy;
end;

function TFileDropAcceptor.DragEnter(const dataObj:IDataObject;
    grfKeyState:Longint;pt:TPoint;var dwEffect:Longint):HResult;stdcall;
var Medium:TSTGMedium;
    Format:TFormatETC;
    NumFiles:Integer;
    i:Integer;
    rslt:Integer;
    FileName:array [0..MAX_PATH]of char;
    S:string;
    CanDrop:boolean;
begin
     dataObj._AddRef;
     Format.cfFormat:=CF_HDROP;
     Format.ptd:=Nil;
     Format.dwAspect:=DVASPECT_CONTENT;
     Format.lindex:=-1;
     Format.tymed:=TYMED_HGLOBAL;
     rslt:=dataObj.GetData(Format,Medium);
     FFileList.Clear;
     if rslt=S_OK then 
     begin
      NumFiles:=DragQueryFile(Medium.hGlobal,$FFFFFFFF,nil,0);
      for i:=0 to NumFiles-1 do
      begin
        DragQueryFile(Medium.hGlobal,i,FileName,sizeof(FileName));
        S:=FileName;
        FFileList.Add(S);
      end;
     end;
     if Medium.unkForRelease=nil then ReleaseStgMedium(Medium);
     dataObj._Release;
     CanDrop:=False;
     if FFileList.Count>0 then 
     begin
       CanDrop:=True;
       if Assigned(FOnFileAccept) then FOnFileAccept(Self,FFileList,CanDrop);
     end;
     Result:=S_OK;
end;

function TFileDropAcceptor.DragOver(grfKeyState:Longint;pt:TPoint;
    var dwEffect:Longint):HResult;stdcall;
begin
     if FFileList.Count>0 then dwEffect:=DROPEFFECT_COPY
     else dwEffect:=DROPEFFECT_NONE;
     Result:=S_OK;
end;

function TFileDropAcceptor.DragLeave:HResult;stdcall;
begin
     Result:=S_OK;
end;

function TFileDropAcceptor.Drop(const dataObj:IDataObject;
    grfKeyState:Longint;pt:TPoint;var dwEffect:Longint):HResult;stdcall;
begin
     if Assigned(FOnFilesDropped) and (FFileList.Count>0) then 
     begin
       FOnFilesDropped(Self,FFileList);
       dwEffect:=DROPEFFECT_COPY;
     end
     else dwEffect:=DROPEFFECT_NONE;
     Result:=S_OK;
end;

initialization
   OleInitialize(nil);

finalization
   OleUninitialize;

end.

Интерфейс IDropTarget реализуется в объекте TInterfacedObject и поэтому требует создания фабрики класса и регистрации в системном реестре.

Его конструктор содержит два метода: первый - FOnFilesDropped - будет вызываться, когда пользователь отпустил кнопку мыши на контейнере, а второй - FOnFileAccept, когда курсор мыши попадает в контейнер. Оба эти метода передают список файлов, которые были выбраны в Windows Explorer.

Соответственно в обработчике события FOnFileAccept необходимо проанализировать список файлов, попытаться их открыть и определить, подходящий ли у них формат. Переменную CanAccept следует установить равной True, если файл(ы) имеет подходящий формат, и False - если нет. Обработчик второго события - FOnFileDropped будет вызываться, только если переменная CanAccept была установлена равной True в обработчике событий FOnFileAccept или если этот обработчик отсутствует. Соответственно в нем следует произвести все манипуляции с выбранными файлами.

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

Перед разрушением контейнера требуется вызвать метод RevokeDragDrop.

Пример кода для контейнера приведен ниже:

unit DTForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileDrop;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure OnFilesDropped(Sender:TObject;const FileNames:TStringList);
    procedure OnDragEnter(Sender:TObject;const FileNames:TStringList;
        var CanEnter:boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
  uses ActiveX;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var FDropAcceptor:TFileDropAcceptor;
begin
     FDropAcceptor:=TFileDropAcceptor.Create(OnFilesDropped,OnDragEnter);
     RegisterDragDrop(ListBox1.Handle,FDropAcceptor as IDropTarget);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     RevokeDragDrop(ListBox1.Handle);
end;

procedure TForm1.OnFilesDropped(Sender:TObject;const FileNames:TStringList);
begin
     ListBox1.Items.Assign(FileNames);
end;

procedure TForm1.OnDragEnter(Sender:TObject;
    const FileNames:TStringList;var CanEnter:boolean);
begin
     CanEnter:=FileNames.Count>1;
end;

end.

Текст этого приложения можно взять здесь (9,4 Кб).

Следует обратить внимание на то, что деструктор объекта FDropAcceptor, в котором реализован интерфейс IDropTarget, нигде не вызывается. Это сделано потому, что при вызове метода RevokeDragDrop происходит разрушение данного объекта. Соответственно нет необходимости хранить ссылку на этот объект, и поэтому он объявлен как локальная переменная.

На следующем шаге мы рассмотрим OLE-реализацию метода drag-and-drop (реализацию источника данных).

Предыдущий шаг Содержание Следующий шаг