Форум по Delphi программированию - Показать сообщение отдельно - [ Исходник ] - TSimpleDragDrop: Drag & Drop файлов из программы в Проводник

alexpac26 · #3 14.10.2012, 15:58

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

Код:

unit DropFileClass;
 
// procedure FromDropFiles(Sender: TObject);
 
interface
 
uses
  Windows, Messages, Classes, SysUtils, AppEvnts,
  Controls, ShellAPI, FileCtrl, ActiveX, ComObj, ShlObj;
type
  TDropEffect = (deNone, deCopy, deMove, deLink);
 
  TDropFile = class(TApplicationEvents, IDropSource)
    protected
      procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); virtual;
      { IDropSource }
      function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
      function GiveFeedback(dwEffect: Longint): HResult; stdcall;
    public
      DropEffect: TDropEffect;
      Files: TStringList;
      OnDropFiles : TNotifyEvent;
      function DropOut(Directory: String; AFileName: String): Integer; overload;
      function DropOut(Directory: String; AFileList: TStrings): Integer; overload;
      function DropOut(AFileList: TStrings): Integer; overload;
      function DropOut(AFileName: String): Integer; overload;
      // методы для анализа
      function MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y: Integer; offset: integer = 0):boolean;
      // конструктор
      constructor Create(AOwner: TWinControl);
      destructor Destroy; override;
  end;
 
// procedure DropFileEvent(Sender: TObject);
 
implementation
 
{ TDropFile }
 
procedure TDropFile.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
var nCount, nFile : UINT;
    sFileNm : string;
    dwChars : DWORD;
const QUERY_FILES_COUNT = UINT($FFFFFFFF);
begin
  if (Msg.message=WM_DROPFILES) and (Msg.hwnd = TWinControl(self.Owner).Handle) then begin
    if @self.OnDropFiles=nil then begin
      // защита от выполнения
      Handled:=true;
      exit;
    end;
    // Событие поймано.
    // отключаем пост обработку
    Handled:=true;
    // обрабатываем событие
    nCount := DragQueryFile( Msg.wParam, QUERY_FILES_COUNT, nil, 0);
    if nCount = 0 then Exit;
    // чистим лист
     Files.Clear;
    try
      for nFile := 0 to nCount-1 do begin
        // GrцЯe des Buffers bestimmen
        dwChars := DragQueryFile( Msg.wParam, nFile, nil,0);
        Inc( dwChars);  // Platz fьr Arnold
        SetLength( sFileNm, dwChars);
        // Dateinamen abrufen
        dwChars := DragQueryFile( Msg.wParam, nFile, PChar(sFileNm), dwChars);
        if dwChars > 0 then begin
          SetLength( sFileNm, dwChars);  // Arnold entsorgen
          Files.Add(sFileNm);
        end;
    end;
    // an der Abwurfstelle im Fenster eine anklickbare Markierung setzen
    finally
      if @self.OnDropFiles<>nil then OnDropFiles(self);
    end;
  end;  // end IF
end;
 
constructor TDropFile.Create(AOwner: TWinControl);
begin
  TApplicationEvents(self).Create(AOwner);
  self.OnMessage:=self.ApplicationEventsMessage;
  Files:=TStringList.Create;
  DropEffect:=deCopy;
  DragAcceptFiles(TWinControl(Owner).Handle, TRUE);
end;
 
destructor TDropFile.Destroy;
begin
  Files.free;
  if Assigned(Owner) then DragAcceptFiles(TWinControl(Owner).Handle, FALSE);
  inherited;
end;
 
function TDropFile.DropOut(AFileList: TStrings): Integer;
var s1:string; i:integer;
begin
  if AFileList.Count=0 then exit;
  Files.Clear;
  s1:=ExtractFilePath(AFileList[0]);
  i:=0;
  repeat
    if (s1<>ExtractFilePath(AFileList[i])) then break;
    Files.Add(ExtractFileName(AFileList[i]));
    inc(i);
  until (i=AFileList.Count);
  DropOut(s1,Files);
  Files.Clear;
end;
 
// базовый обработчик
function TDropFile.DropOut(Directory: String; AFileList: TStrings): Integer;
var
  dataObj: IDataObject;
  Root: IShellFolder;
  pchEaten: ULONG;
  DirectoryItemIDList: PItemIDList;
  dwAttributes: ULONG;
  Folder: IShellFolder;
  i: Integer;
  ItemIDLists: array of PItemIDList;
  dwOKEffects: Longint;
begin
  OleCheck(SHGetDesktopFolder(Root));
 
  OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(Directory)),
    pchEaten, DirectoryItemIDList, dwAttributes));
 
  try
    OleCheck(Root.BindToObject(DirectoryItemIDList, nil, IShellFolder, Folder));
 
    SetLength(ItemIDLists, AFileList.Count);
 
    for i:=0 to AFileList.Count-1 do OleCheck(Folder.ParseDisplayName(0, nil,
      PWideChar(WideString(AFileList[i])),
      pchEaten, ItemIDLists[i], dwAttributes));
 
    try
      OleCheck(Folder.GetUIObjectOf(0, AFileList.Count, ItemIDLists[0],
        IDataObject, nil, dataObj));
    finally
      for i:=0 to AFileList.Count-1 do CoTaskMemFree(ItemIDLists[i]);
    end;
 
    dwOKEffects:=0;
    if deNone = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_NONE;
    if deCopy = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_COPY;
    if deMove = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_MOVE;
    if deLink = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_LINK;
 
    DoDragDrop(dataObj, Self, dwOKEffects, Result);
  finally
    CoTaskMemFree(DirectoryItemIDList);
  end;
end;
 
function TDropFile.DropOut(Directory, AFileName: String): Integer;
begin
  Files.Clear;
  try
    Files.Add(AFileName);
    Result:=DropOut(Directory, Files);
  finally
    Files.Clear;
  end;
end;
 
function TDropFile.DropOut(AFileName: String): Integer;
begin
  Files.Clear;
  try
    Files.Add(ExtractFileName(AFileName));
    Result:=DropOut(ExtractFilePath(AFileName), Files);
  finally
    Files.Clear;
  end;
end;
 
function TDropFile.GiveFeedback(dwEffect: Integer): HResult;
begin
  Result:=DRAGDROP_S_USEDEFAULTCURSORS;
end;
 
function TDropFile.MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y, offset: Integer): boolean;
begin
  result:=false;
  if not (Sender is TControl) then exit;
  if (ssLeft in Shift) and
  ((x<=offset)or(x>=TControl(Sender).Width-5-offset) or
  (y<=offset)or(y>=TControl(Sender).Height-5-offset)) then result:=true;
end;
 
function TDropFile.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Integer): 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;
 
initialization
  OleInitialize(nil);
 
finalization
  OleUninitialize;
 
end.

Методы

DropEffect: TDropEffect;

Тип операции

deNone (0) - нет
deCopy (1) - копирование
deMove (2) - перемещение
deLink (3) - ярлык

Files: TStringList;

Список файлов или папок после события OnDropFiles
Список перемещенных файлов в программу

Constructor Create(Aowner: TWinControl);
От того что передается в качестве родителя компонента TDropFile зависит реакция обработчика
OnDropFiles
То есть если передана форма

Код:

1	`df:=TDropFile.Create(Form1);`

То значит форма будет реагировать на перетаскивание
Если, например, панель

Код:

1	`df:=TDropFile.Create(Panel1);`

То значит панель будет реагировать на перетаскивание, а форма НЕТ
и тп

OnDropFiles : TNotifyEvent;
Ссылка на событие перетаскивания файлов
Задается вручную

Код:

type
  TForm2 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    df: TDropFile; // экземляр класса TDropFile
    procedure FromDropFiles(Sender: TObject); // событие обработчик OnDropFiles
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.dfm}
 
procedure TForm2.FormCreate(Sender: TObject);
begin
  df:=TDropFile.Create(self); // создаем объект
  df.OnDropFiles:=self.FromDropFiles; // задаем обработчик
end;
 
procedure TForm2.FromDropFiles(Sender: TObject);
begin
  // обрабатываем событие перетаскивания файлов в программу
  ListBox1.Clear;
  ListBox1.Items.AddStrings(df.Files);
  // в df.Files лежит список файлов или папок которые были перенесены в программу
end;

function DropOut(Directory: String; AFileName: String): Integer; overload;
function DropOut(Directory: String; AFileList: TStrings): Integer; overload;
function DropOut(AFileList: TStrings): Integer; overload;
function DropOut(AFileName: String): Integer; overload;

1) работает с одним файлом
2) второй со списком.
3) Третий работает со списком абсолютных путей
4) Червертый работает с одним абсолютным адресом файла

Directory указывает на каталог в котором находятся файлы. AFileName и AFileList содержат имена файлов.

Результат операции:
0 - отменено пользователем (нажал Esc) = DROPEFFECT_NONE
1 - файл скопирован = DROPEFFECT_COPY
2 - файл перемещен. Если поддерживает источник, то исходный файл будет удален = DROPEFFECT_MOVE
4 - создана ссылка на файл = DROPEFFECT_LINK

function MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y: Integer; offset: integer = 0):boolean;

Функция проверяет что можно запускать DropOut
Вызывается внутри MouseMove события компонента

offset - отступ от рамки внутрь. Рекомендуется 10 пикселей.
Проще говоря задает отступ от рамки при котором разрешен DropOut

Код:

procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if df.MouseMoveDrop(Sender,Shift,X,Y,10) then // проверяем что запуск разрешен
    df.DropOut(FileListBox1.Directory,FileListBox1.Items); // запускаем перетаскивание
end;

Можно написать любой свой обработчик