Drag and Drop для файлов, как реализовать?

[User32]

Нужно реалшизовать Drag and Drop для файлов.

Попросту перетаскивание файла на форму Form1 (обработчик события №1)

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, {} ShellAPI;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure FileIsDropped(var Msg: TMessage); message WM_DropFiles;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FileIsDropped(var Msg: TMessage);
var
  hDrop: integer;
  Point: TPoint;
  i: integer;
  CountFiles: integer;
  cch: integer;
  SizeName: integer;
  lpszFile: PChar;
begin
  hDrop := Msg.WParam;
  DragQueryPoint(hDrop, Point);
  CountFiles := DragQueryFile(hDrop, $FFFFFFFF, nil, cch);
  for i := 0 to CountFiles - 1 do
  begin
    SizeName := DragQueryFile(hDrop, i, nil, cch);
    GetMem(lpszFile, SizeName + 1);
    DragQueryFile(hDrop, i, lpszFile, SizeName + 1);
    Memo1.Lines.Add('Áðîñàåì ' + IntToStr(CountFiles) + ' ôàéëà(îâ) : ' + lpszFile);
    FreeMem(lpszFile, SizeName + 1);
  end;
  DragFinish(hDrop);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;
 
end.

А как перетащить значка из ListView1 SelectItem в окно проводника Windows (обработчик события №2)
чтобы получить событие?

Ну вот и всё что меня интересует.
Прилагаю пример.

Сообщение отредактировано: User32 - 08.04.09, 14:01

Прикреплённый файлD_D.zip (2.76 Кбайт, скачиваний: 307)

[User32]

Как реализовать Drag&Drop файлов из моей программы в проводник Windows.
Нужно перетащить Item из ListView в проводник Windows или рабочий стол и создать событие к примеру сообщение.

[Lumen]

Можно послать целевой программе WM_DROPFILES.
Или вот ещё пример реализации.

[andrew.virus]

Цитата User32 @ 09.04.09, 07:08

Как реализовать Drag&Drop файлов из моей программы в проводник Windows.
Нужно перетащить Item из ListView в проводник Windows или рабочий стол и создать событие к примеру сообщение.

для решения задач, связанных с перемещением файлов между проводником и приложением, а также обработки перемещения данных произвольного типа, есть очень хорошая и удобная библиотека "Drag and Drop Component Suite" ...

среди примеров к ней есть не только перемещение из программы в проводник и обратно списка файлов, но и примеры работы с буфером обмена ... библиотека является opensources её код прилагаю в архиве ...
Прикреплённый файлdragdrop_library.zip (113.65 Кбайт, скачиваний: 986)

[andrew.virus]

User32 а это примеры использования данной библиотеки "Drag and Drop Component Suite" ...
Прикреплённый файлdragdrop_demos.zip (189.13 Кбайт, скачиваний: 703)

[User32]

Спасибо, как раз то что доктор прописал...

[Fr0sT]

Есть кое-что лишнее в коде из #1, вот улучшенный вариант (удалены лишние переменные, используется string вместо Pchar с ручным выделением памяти):

procedure TForm1.FileIsDropped(var Msg: TMessage);
var
  hDrop: integer;
  i: integer;
  CountFiles: integer;
  SizeName: integer;
  FileName: string;
begin
  hDrop := Msg.WParam;
  CountFiles := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);
  for i := 0 to CountFiles - 1 do
  begin
    SizeName := DragQueryFile(hDrop, i, nil, 0);
    SetLength(FileName, SizeName + 1);
    DragQueryFile(hDrop, i, PChar(FileName), SizeName + 1);
    Memo1.Lines.Add('Dropped file: ' + FileName);
  end;
  DragFinish(hDrop);
  Memo1.Lines.Add('Total files dropped: ' + IntToStr(CountFiles));
end;

Для получения единственного файла - ещё проще:

procedure TForm1.FileDropped(var Msg: TMessage);
var hDrop: integer;
    i: integer;
    NameSize: integer;
    FileName: string;
begin
  hDrop := Msg.WParam;
  NameSize := DragQueryFile(hDrop, 0, nil, 0);
  SetLength(FileName, NameSize+1);
  DragQueryFile(hDrop, 0, PChar(FileName), NameSize+1);
  DragFinish(hDrop);
  Memo1.Lines.Add(FileName);
end;

Сообщение отредактировано: Fr0sT - 12.03.10, 09:23

[User32]

Цитата Fr0sT @ 12.03.10, 09:21

Есть кое-что лишнее в коде из #1, вот улучшенный вариант (удалены лишние переменные, используется string вместо Pchar с ручным выделением памяти):

procedure TForm1.FileIsDropped(var Msg: TMessage);
var
  hDrop: integer;
  i: integer;
  CountFiles: integer;
  SizeName: integer;
  FileName: string;
begin
  hDrop := Msg.WParam;
  CountFiles := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);
  for i := 0 to CountFiles - 1 do
  begin
    SizeName := DragQueryFile(hDrop, i, nil, 0);
    SetLength(FileName, SizeName + 1);
    DragQueryFile(hDrop, i, PChar(FileName), SizeName + 1);
    Memo1.Lines.Add('Dropped file: ' + FileName);
  end;
  DragFinish(hDrop);
  Memo1.Lines.Add('Total files dropped: ' + IntToStr(CountFiles));
end;

Для получения единственного файла - ещё проще:

procedure TForm1.FileDropped(var Msg: TMessage);
var hDrop: integer;
    i: integer;
    NameSize: integer;
    FileName: string;
begin
  hDrop := Msg.WParam;
  NameSize := DragQueryFile(hDrop, 0, nil, 0);
  SetLength(FileName, NameSize+1);
  DragQueryFile(hDrop, 0, PChar(FileName), NameSize+1);
  DragFinish(hDrop);
  Memo1.Lines.Add(FileName);
end;

Спасибо за оптимизацию. А вот как сделать чтобы приложение работало как источник данных.
Проще говоря как без сторонних компонентов реализовать перетаскивание объектов из приложения в проводник (Explorer) Windows.
В моем случаи из ListView в проводник. Почитал статью http://delphinews.ru/booksnet/d3_lib/ch_04.htm
Так там по моему написана полная ахинея... нет ни последовательности ни логики а главное с ошибками, много чего не декларировано (по крайне мере мне собрать в Delphi 6 так и не удалось без ошибок примеры).

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

Сообщение отредактировано: User32 - 12.03.10, 13:33

[User32]

Немного обновляю тему. Сейчас попробовал реализовать приемник через OLE, вот что получилось:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ShellAPI, StdCtrls;
 
type
  TForm1 = class(TForm, IDropTarget)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function IDropTarget.DragOver = DragOver2;
    function DragOver2(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;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
//------------------------------------------------------------------------------
 
function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  f: FORMATETC;
begin
  ZeroMemory(@f, SizeOf(f));
  f.cfFormat := CF_HDROP;
  f.lindex := -1;
  f.tymed := TYMED_HGLOBAL;
  if dataObj.QueryGetData(f) = S_OK then
  begin
    dwEffect := DROPEFFECT_COPY;
    Result := S_OK;
 end
   else Result := E_ABORT;
end;
 
//------------------------------------------------------------------------------
 
function TForm1.DragLeave: HResult;
begin
  Result := S_OK;
end;
 
//------------------------------------------------------------------------------
 
function TForm1.DragOver2(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;
 
//------------------------------------------------------------------------------
 
function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  f: FORMATETC;
  m: STGMEDIUM;
  i, cnt: Integer;
  fn: array[1..MAX_PATH] of Char;
begin
  ZeroMemory(@f, SizeOf(f));
  f.cfFormat := CF_HDROP;
  f.lindex := -1;
  f.tymed := TYMED_HGLOBAL;
  if dataObj.GetData(f, m) = S_OK then
  begin
    cnt := DragQueryFile(m.hGlobal, $FFFFFFFF, nil, 0);
    for i := 0 to cnt - 1 do
    begin
      DragQueryFile(m.hGlobal, i, @fn, MAX_PATH);
      ShowMessage(PChar(@fn)); //DEBUG MESSAGE!!!
    end;
    if m.unkForRelease <> nil then
    IUnknown(m.unkForRelease)._Release;
  end;
  Result := S_OK;
end;
 
//------------------------------------------------------------------------------
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterDragDrop(Handle, Self);
end;
 
//------------------------------------------------------------------------------
 
initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.

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

[User32]

С источником пока заминка, несоображу как по простому определить что курсор вышел за пределы формы...
Да и с организацией виртуального источника датнных пока проблема.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj, ComCtrls;
 
type
  TForm1 = class(TForm, IDropSource)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FDragStartPos: TPoint;
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
//------------------------------------------------------------------------------
 
function TForm1.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Longint): HResult; stdcall;
begin
  if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then
  begin
    Result := DRAGDROP_S_CANCEL
  end else if grfKeyState and MK_LBUTTON = 0 then
  begin
    Result := DRAGDROP_S_DROP
  end else
  begin
    Result := S_OK;
  end;
end;
 
//------------------------------------------------------------------------------
 
function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
 
//------------------------------------------------------------------------------
 
procedure TForm1.FormCreate(Sender: TObject);
var
  NewColumn: TListColumn;
begin
//
  with ListView1 do
  begin
    Align := alClient;
    ViewStyle := vsReport;
    NewColumn := Columns.Add;
    NewColumn.Caption := 'Name';
    NewColumn := Columns.Add;
    NewColumn.Caption := '1';
    NewColumn := Columns.Add;
    NewColumn.Caption := '2';
end;
 
  ListView1.AddItem('test.txt', nil);
end;
 
//------------------------------------------------------------------------------
 
procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    FDragStartPos.x := X;
    FDragStartPos.y := Y;
  end;
end;
 
//------------------------------------------------------------------------------
 
procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
const
  Threshold = 100;
var
  SelFileList: TStrings;
  i: Integer;
  DataObject: IDataObject;
  Effect: DWORD;
//  CurMouse: TPoint;
begin
//  GetCursorPos(CurMouse);
  with Sender as TListView do
  begin
    if (ListView1.SelCount > 0) and (csLButtonDown in ControlState)
      and ((Abs(X - FDragStartPos.X) >= Threshold)
///      and ((Abs(X - FDragStartPos.X) >= 302)
      or (Abs(Y - FDragStartPos.Y) >= Threshold)) then
///      or (Abs(Y - FDragStartPos.Y) >= 202)) then
      begin
      Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));
      SelFileList := TStringList.Create;
      try
        SelFileList.Capacity := ListView1.SelCount;
        for i := 0 to ListView1.Items.Count - 1 do
          SelFileList.Add(ListView1.Items[i].Caption);
//        DataObject := GetFileListDataObject(DataSource, SelFileList);
          ShowMessage(SelFileList.Text); //DEBUG MESSAGE!!!
      finally
        SelFileList.Free;
      end;
      Effect := DROPEFFECT_NONE;
//      DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
    end;
  end;
end;
 
//------------------------------------------------------------------------------
 
initialization
  OleInitialize(nil);
finalization
  OleUninitialize;
end.

Сообщение отредактировано: User32 - 17.03.10, 07:50