Шаг 12.
Применение COM-объектов, входящих в Windows. OLE-реализация метода drag-and-drop (реализация источника данных)

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

С помощью СОМ-технологии можно реализовать и обратную операцию, именно превратить приложение в источник данных для операции drag-and-drop. Соответственно такие объекты могут быть переданы Windows Explorer для перемещения, создания копий, ярлыков и т.д.

    Для реализации источника данных требуется описание трех интерфейсов - IDropSource, IDataObject и IEnumFormatEtc. Интерфейс IDropSource определяет тип курсора, возникающего при перетаскивании файлов, и информирует об окончании или продолжении операции по перетаскиванию файлов. IDataObject подготавливает список файлов в специальном формате, который определяется в структуре TDropFiles. Эти данные передаются по требованию приложению-клиенту, над окном которого была отпущена кнопка мыши. И наконец, IEnumFormatEtc используется интерфейсом IDataObject для получения информации от клиента о том, какие именно форматы им поддерживаются.

    Для перетаскивания файлов в IDataObject необходимо реализовать поддержку единственного формата - CF_HDROP. Абсолютно все методы интерфейсов IDropSource и IEnumFormatEtc обязаны быть реализованы как работающие методы - ни один из них не должен возвращать E_NOTIMPL, константу, которая указывает, что интерфейс не поддерживает вызываемый метод. Что касается интерфейса IDataObject, то достаточно реализовать три его метода - GetData, QueryGetData и EnumFormatEtc. Все остальные методы могут возвращать E_NOTIMPL. Ниже приведен текст модуля, содержащий реализацию всех трех интерфейсов: 

unit DataObj;

interface
uses Windows,ActiveX,Classes;

type
    TDataRequestNotify=procedure(const DataList:TStringList;
          IsFirstTime:boolean)of object;
    TFileSource=class(TinterfacedObject,IDropSource)
      function QueryContinueDrag(fEscapePressed:BOOL;
          grfKeyState:Longint):HResult;stdcall;
      function GiveFeedback(dwEffect:Longint):HResult;stdcall;
    end;
    TDataObject=class(TinterfacedObject,IDataObject)
    private
     FFileList:TStringList;
     FDataRequest:TDataRequestNotify;
     FIsFirstTime:boolean;
     FDropPoint:TPoint;
     FInClient:boolean;
     function StorageSize:integer;
    public
     constructor Create(const AFileList:TStringList;ADataRequest:TDataRequestNotify;
             DropPoint:TPoint;InClient:boolean);
     destructor Destroy;override;
     {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 ShlObj,SysUtils;

const
     DataFormatCount=1;

type
    PFormatList=^TFormatList;
    TFormatList=array [0..DataFormatCount-1] of TFormatEtc;

var
   DataFormats:TFormatList;

type
    TEnumFormatEtc=class(TinterfacedObject,IEnumFormatEtc)
    private
     FFormatList:PFormatList;
     FFormatCount:Integer;
     Findex:Integer;
    public
     constructor Create(FormatList:PFormatList;
            FormatCount,Index:Integer);
     function Next(celt:Longint;out elt;pceltFetched:PLongint):HResult;stdcall;
     function Skip(celt:Longint):HResult;stdcall;
     function Reset:HResult;stdcall;
     function Clone(out enum:IEnumFormatEtc):HResult;stdcall;
    end;

function TFileSource.QueryContinueDrag(fEscapePressed:BOOL;
    grfKeyState:Longint):HResult;
begin
     if fEscapePressed then Result:=DRAGDROP_S_CANCEL
     else 
        if (grfKeyState and MK_LBUTTON)=0 then Result:=DRAGDROP_S_DROP
        else Result:=S_OK;
end;

function TFileSource.GiveFeedback(dwEffect:Longint):HResult;
begin
     case dwEffect of
          DROPEFFECT_NONE,
          DROPEFFECT_COPY,
          DROPEFFECT_LINK,
          DROPEFFECT_SCROLL:Result:=DRAGDROP_S_USEDEFAULTCURSORS;
          else Result:=S_OK;
     end;
end;
{---------------------------}
constructor TEnumFormatEtc.Create(FormatList:PFormatList;FormatCount,Index:Integer);
begin
     inherited Create;
     FFormatList:=FormatList;
     FFormatCount:=FormatCount;
     FIndex:=Index;
end;

function TEnumFormatEtc.Next(celt:Longint;out elt;pceltFetched:Plongint):HResult;
var i:integer;
begin
     i:=0;
     while (i<celt)and(FIndex<FFOrmatCount) do
     begin
      TFormatList(elt)[i]:=FFOrmatList[FIndex];
      inc(FIndex);
      inc(i);
     end;
     if pceltFetched<>nil then pceltFetched^:=i;
     if i=celt then Result:=S_OK
     else Result:=S_FALSE;
end;

function TEnumFormatEtc.Skip(celt:Longint):HResult;
begin
     if celt<=FFormatCount-FIndex then 
     begin
      FIndex:=FIndex+celt;
      Result:=S_OK;
     end
     else begin
           FIndex:=FFOrmatCount;
           Result:=S_FALSE;
     end;
end;

function TEnumFormatEtc.Reset:HResult;
begin
     FIndex:=0;
     Result:=S_OK;
end;

function TEnumFormatEtc.Clone(out enum:IEnumFormatEtc):HResult;
begin
     enum:=TEnumFormatEtc.Create(FFormatList,FFormatCount,FIndex);
     Result:=S_OK;
end;
{----------------------------}
constructor TDataObject.Create(const AFileList:TStringList;
    ADataRequest:TDataRequestNotify; DropPoint:TPoint;InClient:boolean);
begin
     inherited Create;
     FFileList:=TStringList.Create;
     FFileList.Assign(AFileList);
     FDataRequest:=ADataRequest;
     FIsFirstTime:=True;
     FDropPoint:=DropPoint;
     FInClient:=InClient;
end;

destructor TDataObject.Destroy;
begin
     if Assigned(FFileList)
                           then FFileList.Free;
     inherited Destroy;
end;

function TDataObject.StorageSize:integer;
var i:integer;
begin
     Result:=sizeof(TDropFiles);{Double-terminated null}
     if FFileList.Count>0 then 
       for i:=0 to FFIleList.Count-1 do
             Result:=Result+length(FFileList[i])+1;
     inc(Result);
end;

function TDataObject.GetData(const formatetcIn:TFormatEtc;
   out medium:TStgMedium):HResult;
var Data:HGlobal;
    P:pchar;
    i,n:integer;
    DF:PDROPFIles;
    S:string;
begin
     Result:=DV_E_FORMATETC;
     medium.tymed:=0;
     medium.hGlobal:=0;
     medium.unkForRelease:=nil;
     with formatetcIn do
       if (cfFormat=CF_HDROP) and
          (dwAspect=DVASPECT_CONTENT) and
          (tymed=TYMED_HGLOBAL) then 
       begin
         if Assigned(FDataRequest) then FDataRequest(FFileList,FIsFirstTime);
         FIsFirstTime:=False;
         Data:=GlobalAlloc(GMEM_SHARE or 
               GMEM_MOVEABLE or GMEM_ZEROINIT,StorageSize);
         if (Data<>0) and (FFileList.Count>0) then 
         begin
           DF:=GlobalLock(Data);
           if Assigned(DF) then 
           begin
             DF.pFiles:=sizeof(TDropFiles);
             DF.pt:=FDropPoint;
             DF.fNC:=FInClient;
             DF.fWide:=False;
             P:=pchar(DF);
             n:=sizeof(TDropFiles);
             for i:=0 to FFileList.Count-1 do
             begin
               S:=FFileList[i];
               System.Move(S[1],P[n],length(S));
               n:=n+length(s)+1;
             end;
             GlobalUnlock(Data);
           end;
           medium.tymed:=TYMED_HGLOBAL;
           medium.hGlobal:=Data;
           Result:=S_OK;
         end;
       end;
end;

function TDataObject.GetDataHere(const formatetc:TFormatEtc;
   out medium:TStgMedium):HResult;
begin
     Result:=DV_E_FORMATETC;
end;

function TDataObject.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 TDataObject.GetCanonicalFormatEtc(const formatetc:TFormatEtc;
    out formatetcOut:TFormatEtc):HResult;
begin
     formatetcOut.ptd:=nil;
     Result:=E_NOTIMPL;
end;

function TDataObject.SetData(const formatetc:TFormatEtc;
   var medium:TStgMedium;fRelease:BOOL):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TDataObject.EnumFormatEtc(dwDirection:Longint;
    out enumFormatEtc:IEnumFormatEtc):HResult;
begin
     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;

function TDataObject.DAdvise(const formatetc:TFormatEtc;advf:Longint;
    const advSink:IAdviseSink;out dwConnection:Longint):HResult;
begin
     Result:=OLE_E_ADVISENOTSUPPORTED;
end;

function TDataObject.DUnadvise(dwConnection:Longint):HResult;
begin
     Result:=OLE_E_ADVISENOTSUPPORTED;
end;

function TDataObject.EnumDAdvise(out enumAdvise:IEnumStatData):HResult;
begin
     Result:=OLE_E_ADVISENOTSUPPORTED;
end;
{--------------------------}

initialization
  DataFormats[0].cfFormat:=CF_HDROP;
  DataFormats[0].ptd:=nil;
  DataFormats[0].dwAspect:=DVASPECT_CONTENT;
  DataFormats[0].lindex:=-1;
  DataFormats[0].tymed:=TYMED_HGLOBAL;
  OleInitialize(nil);

finalization
  OleUnInitialize;

end.

    Метод QueryContinueDrag интерфейса IDropSource вызывается всякий раз, когда происходит изменение в состоянии специальных клавиш клавиатуры (Esc) и/или кнопок мыши. Возможен возврат одного из трёх значений:

    Метод GiveFeedback принимает в качестве параметра информацию о том, как целевой элемент управления хочет распорядиться данными. Он должен вернуть тип курсора для ожидаемой операции - обычно это DRAGDROP_S_USEDEFAULTCURSORS.

    Метод Next интерфейса IEnumFormatEtc возвращает список форматов начиная с текущей позиции внутреннего счетчика FIndex. Требуемое их число содержится в переменной celt. Формат этого списка приведен в структуре TFormatList. Эти данные помещаются в переменную elt, место в памяти для которой обязано зарезервировать клиентское приложение. И наконец, в указателе pceltFetched помещается суммарное число форматов, записанных в переменной elt (если указатель указывает на какую-либо область в памяти). Метод Skip перемещает внутренний счетчик FIndex на elt записей вперед. Метод Reset устанавливает внутренний счетчик на первый элемент в списке форматов, поддерживаемый данным интерфейсом. И наконец, метод Clone создает копию интерфейса с текущим значением внутреннего счетчика.

    Конструктор объекта, реализующего IDataObject, принимает в качестве параметpa список выбранных файлов, координаты точки и флаг, указывающий, должен ли находиться курсор мыши в клиентской области элемента управления, над которым он проходит, или нет. Все эти данные будут передаваться клиенту в структуре TDropFiles. Однако чаще всего клиент не анализирует значения координат точки и флага fNC. Кроме того, в конструктор передается адрес нотификационного сообщения, которое будет вызываться всякий раз, когда IDataObject передает данные клиенту. Это сообщение можно использовать, например, чтобы создать файлы на носителе, если они ранее не были созданы. Поэтому нотификационное сообщение содержит еще один параметр - IsFirstTime, указывающий, первый ли раз вызывается оно из данной копии TDataObject или нет.

    Метод GetData создает структуру TDropFiles в памяти и заполняет ее. Структура TDropFiles содержит заголовок, а за ним - имена выбранных файлов и пути к ним. Они разделяются NULL-символами, а после последнего имени файла обязано находиться два NULL-символа. Данный метод проверяет, запрашивается ли поддерживаемый формат, и если он поддерживается, то возвращает значение S_OK, в противном случае DV_E_FORMATETC.

    И наконец, метод EnumFormatEtc возвращает интерфейс IEnumFormatEtc. Этот же метод может быть использован для добавления новых форматов к IDataObject, но данная возможность не поддерживается в этом примере.

    Ниже приведен исходный код модуля, реализующий OLE-источник данных: 

unit DSForm;

interface

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

type
  TForm1 = class(TForm)
    LBFiles: TListBox;
    Label1: TLabel;
    procedure LBFilesMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LBFilesMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LBFilesMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    DragPoint:TPoint;
    FDragStarted:boolean;
    procedure GetDataNotify(const DataList:TStringList;IsFirstTime:boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses DataObj,ComObj,ActiveX;

{$R *.dfm}

procedure TForm1.LBFilesMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     if mbLeft=Button  then 
      begin
        DragPoint.X:=X;
        DragPoint.Y:=Y;
      end
end;

procedure TForm1.LBFilesMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     if Button=mbLeft then 
     begin
       DragPoint.X:=$FFFFFFFF;
       DragPoint.Y:=$FFFFFFFF;
     end;
end;

procedure TForm1.LBFilesMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var FileSource:TFileSource;
    DataObject:TDataObject;
    DP:TPoint;
    dwEffect:LongInt;
    FileList:TStringList;
    i:integer;
    CD,S:string;
begin
     if FDragStarted then Exit;
     if (ssLeft in Shift) and 
        (DragPoint.X<>$FFFFFFFF) and
        (DragPoint.Y<>$FFFFFFFF) then 
      if (abs(X-DragPoint.X)+abs(Y-DragPoint.Y))>10 then 
      begin
         FDragStarted:=True;
         DragPoint.X:=$FFFFFFFF;
         DragPoint.Y:=$FFFFFFFF;
         FileList:=nil;
         try
           FileList:=TStringList.Create;
           GetDir(0,CD);
           for i:=0 to LBFiles.Items.Count-1 do
            if LBFiles.Selected[i] then 
            begin
              S:=CD+'\'+LBFiles.Items[i];
              FileList.Add(S);
            end;
            if FileList.Count>0 then 
            begin
              FileSource:=TFileSource.Create;
              DP.X:=100;
              DP.Y:=100;
              DataObject:=TDataObject.Create(FileList,GetDataNotify,DP,True);
              OleCheck(DoDragDrop(DataObject as IDataObject,
                  FileSource as IDropSource,
                  DROPEFFECT_COPY,
                  dwEffect));
            end;
         finally
            FileList.Free;
            {It is not necessary to destroy IDataObject and    }
            {IDropSource - they will be destroyed automatically}
            FDragStarted:=False;
         end;
      end;
end;

procedure TForm1.GetDataNotify(const DataList:TStringList;IsFirstTime:boolean);
var F:TextFile;
    i:integer;
begin
     if not IsFirstTime then Exit;
     if Assigned(DataList) and (DataList.Count>0) then 
       for i:=0 to DataList.Count-1 do
       begin
         AssignFile(F,DataList[i]);
         Rewrite(F);
         Writeln(F,ExtractFileName(DataList[i]));
         CloseFile(F);
       end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var CD,S:string;
    i:integer;
begin
     GetDir(0,CD);
     for i:=0 to LBFiles.Items.Count-1 do
         if LBFiles.Selected[i] then 
         begin
           S:=CD+'\'+LBFiles.Items[i];
           DeleteFile(S);
         end;
end;

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

    Данный модуль связан с формой, на которой размещен компонент TListBox со списком файлов от 1.txt до 6.txt. В списке можно выбирать несколько строк (рис.1).


Рис.1. Источник данных для операции drag-and-drop

    Внутренняя переменная DragPoint запоминает точку, где была нажата левая кнопка мыши. Если курсор с нажатой кнопкой был смещен более чем на 10 пикселей, то в обработчике события OnMouseMove начинается операция по перемещению файлов. При этом выставляется флаг, указывающий, что перемещение запущено в переменной FDragStarted, а также создается объект FileList, куда помещаются все выбранные из списка названия файлов, к которым добавляется путь, соответствующий текущему каталогу. После этого создаются экземпляры объектов, реализующих интерфейсы IDropSource и IDataObject. Далее происходит вызов метода DoDragDrop, который в качестве параметров принимает ссылки на данные интерфейсы и выполняет OLE-метод drag-and-drop. После окончания DoDragDrop объект FileList разрушается. Следует обратить внимание, что явно не вызывается деструктор объектов, поддерживающих интерфейсы. Деструкторы этих объектов вызываются автоматически после завершения операции drag-and-drop.

    Во время операции drag-and-drop интерфейс IDataObject вызывает метод GetDataNotify. В этом методе, если он был вызван в первый раз, создаются выбранные файлы. И наконец, при создании формы файлы удаляются с диска, если они ранее там находились.

    Со следующего шага мы начнем более детально знакомиться с понятием интерфейса.




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