Drag and Drop с другого приложения, Drag and Drop файлов

Drag and Drop c Explorer

2017-08-09T19:49:35+07:00

Code:

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs,

ComCtrls;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

procedure FileIsDropped(var Msg: TMessage); message WM_DropFiles;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses

shellapi;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

DragAcceptFiles(Handle, True);

end;

procedure TForm1.FileIsDropped(var Msg: TMessage);

var

hDrop: THandle;

fName: array[0..254] of CHAR;

NumberOfFiles: INTEGER;

fCounter: INTEGER;

Names: string;

begin

hDrop := Msg.WParam;

NumberOfFiles := DragQueryFile(hDrop, -1, fName, 254);

Names := '';

for fCounter := 1 to NumberOfFiles do

begin

DragQueryFile(hDrop, fCounter, fName, 254);

// Здесь вы получаете один к одному имя вашего файла

Names := Names + #13#10 + fName;

end;

ShowMessage('Бросаем ' + IntToStr(NumberOfFiles) + ' файла(ов) : ' + Names);

DragFinish(hDrop);

end;

end.

Подробнее...

Drag and Drop с минимизированным приложением

2017-08-09T19:50:57+07:00

В ситуации, когда ваше приложение минимизировано, необходимо понимать, что окно главной формы НЕ работает. Фактически, если вы проверяете окно главной формы, и обнаруживаете, что оно имеет прежний размер, не удивляйтесь, оно просто невидимо. Иконка минимизированного Delphi-приложения принадлежит объекту Application, чей дескриптор окна - Application.Handle.

Вот некоторый код из моей программы, который с помощью компонента CheckBox проверяет возможность принятия перетаскиваемых файлов минимизированным приложением:

Подробнее...

Как пpинимать яpлыки пpи пеpетягивании их на контpол

2017-08-09T19:44:56+07:00

Автор: Nomadic

Code:

TForm1 = class(TForm)

...

private

{ Private declarations }

procedure WMDropFiles(var M: TWMDropFiles); message WM_DROPFILES;

...

end;

var

Form1: TForm1;

implementation

uses

StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;

procedure TForm1.FormCreate(Sender: TObject);

begin

...

DragAcceptFiles(Handle, True);

...

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

...

DragAcceptFiles(Handle, False);

...

end;

procedure TForm1.WMDropFiles(var M: TWMDropFiles);

var

hDrop: Cardinal;

n: Integer;

s: string;

begin

hDrop := M.Drop;

n := DragQueryFile(hDrop, 0, nil, 0);

SetLength(s, n);

DragQueryFile(hDrop, 0, PChar(s), n + 1);

DragFinish(hDrop);

M.Result := 0;

FileOpen(s);

end;

procedure TForm1.FileOpen(FileName: string);

begin

if CompareText(ExtractFileExt(FileName), '.lnk') = 0 then

FileName := ResolveShortcut(Application.Handle, FileName);

DocName := ExtractFileName(FileName);

Caption := Application.Title + ' - ' + DocName;

...

end;

function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;

var

obj: IUnknown;

isl: IShellLink;

ipf: IPersistFile;

pfd: TWin32FindDataA;

begin

Result := '';

obj := CreateComObject(CLSID_ShellLink);

isl := obj as IShellLink;

ipf := obj as IPersistFile;

ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);

with isl do

begin

Resolve(Wnd, SLR_ANY_MATCH);

SetLength(Result, MAX_PATH);

GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);

Result := PChar(Result);

end;

Как перетаскивать файлы?

2017-08-09T19:42:37+07:00

как принимать "перетаскиваемые" файлы.

При получении программой файлов, окну посылается сообщение WM_DROPFILES.

При помощи функции DragQueryFile можно определить количество и имена файлов.

При помощи функции DragQueryPoint можно определить координату мыши в тот момент,

когда пользователь "отпустил" файлы.

Подробнее...

Как послать данные другому приложению используя auto-drag-n-drop?

2017-08-09T19:46:24+07:00

Code:

uses

ShellAPI;

function MakeDrop(const FileNames: array of string): THandle;

// Creates a hDrop Object

var

I, Size: Integer;

Data: PDragInfoA;

P: PChar;

begin

// Calculate memory size needed

Size := SizeOf(TDragInfoA) + 1;

for I := 0 to High(FileNames) do

Inc(Size, Length(FileNames[I]) + 1);

// allocate the memory

Result := GlobalAlloc(GHND or GMEM_SHARE, Size);

if Result <> 0 then

begin

Data := GlobalLock(Result);

if Data <> nil then

try

// fill up with data

Data.uSize := SizeOf(TDragInfoA);

P := PChar(@Data.grfKeyState) + 4;

Data.lpFileList := P;

// filenames at the at of the header (separated with #0)

for I := 0 to High(FileNames) do

begin

Size := Length(FileNames[I]);

Move(Pointer(FileNames[I])^, P^, Size);

Inc(P, Size + 1);

end;

finally

GlobalUnlock(Result);

end

else

begin

GlobalFree(Result);

Result := 0;

end;

function MyEnum(Wnd: hWnd; Res: PInteger): Bool; stdcall;

// search for a edit control with classname 'TEditControl'

var

N: string;

begin

SetLength(N, MAX_PATH);

SetLength(N, GetClassName(Wnd, Pointer(N), Length(N)));

Result := AnsiCompareText('TEditControl', N) <> 0;

if not Result then Res^ := Wnd;

end;

// Example: Open msdos.sys in Delphi's Editor window

procedure TForm1.Button1Click(Sender: TObject);

var

Wnd: HWnd;

Drop: hDrop;

begin

// search for Delphi's Editor

EnumChildWindows(FindWindow('TEditWindow', nil), @MyEnum, Integer(@Wnd));

if IsWindow(Wnd) then

begin

// Delphi's Editor found. Open msdos.sys

Drop := MakeDrop(['c:\msdos.sys']);

if Drop <> 0 then PostMessage(Wnd, wm_DropFiles, Drop, 0);

// Free the memory?

GlobalFree(Drop);

end;

Как сделать Drag-n-Drop из чужого приложения?

2017-08-09T19:48:08+07:00

Code:

{

The following example demonstrates the Drag&Drop machanism from an external

application (Wordpad, Microsoft,..) to a TMemo in your own application.

}

unit TMemoDragDropFrm;

{ ****************************************************************

Source File Name : TMemoDragDropFrm.pas

Typ : Hauptformular

Autor : Andreas Kosch

Compiler : Delphi 4.02 CSS

Betriebssystem : Windows 98

Beschreibung : Text via OLE Drag&Drop ubernehmen aus einer

anderen Anwendung (wie zum Beispiel WordPad)

ubernehmen.

16.01.2003: Test mit Delphi 7 und Microsoft Word XP unter Windowx XP

**************************************************************** }

{ Comments by Thomas Stutz }

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls;

type

// TForm1's declaration indicates that it's a TForm and that

// it supports the IDropTarget interface:

{

IDropTarget

Any application wanting to accept drop operations must

implement the IDropTarget interface.

Methods of the IDropTarget interface:

DragEnter

Dragged item has just been moved into the application's window,

return the relevant icon.

DragOver

Dragged item is being moved over the application's window,

return the relevant icon.

DragLeave

Dragged item has just moved out of the application's window.

Drop

The dragged item has been dropped on this application.

}

TForm1 = class(TForm, IDropTarget)

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

// IDropTarget

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;

// IUnknown

// Ignore referance counting

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

public

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

ShellAPI;

// In the OnCreate event handler, two important methods are called.

// First, OleInitalize is called. This initializes the OLE libraries and should always be

// called before your application uses any OLE functions.

// RegisterDragDrop registers the window as a valid drop target.

// If this isn't called, the window will never receive any drop events.

procedure TForm1.FormCreate(Sender: TObject);

begin

OleInitialize(nil);

{Allow window to accept drop events}

OleCheck(RegisterDragDrop(Handle, Self));

{ Execute Wordpad for testing }

ShellExecute(Handle, 'open', 'wordpad', 'c:\Test.doc', nil, SW_SHOW);

end;

// OnDestroy does the exact opposite. It calls RevokeDropTarget to indicate that

// drop events are no longer accepted.

// It then calls OleUninitialize, since the application is finished using all OLE functions.

procedure TForm1.FormDestroy(Sender: TObject);

begin

{Finished accepting drops}

RevokeDragDrop(Handle);

OleUninitialize;

end;

{-----------------------------------------------------------------}

{ IDropTarget-Implementierung }

{-----------------------------------------------------------------}

function TForm1.DragEnter(const dataObj: IDataObject;

grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

begin

dwEffect := DROPEFFECT_COPY;

Result := S_OK;

end;

function TForm1.DragOver(grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

begin

dwEffect := DROPEFFECT_COPY;

Result := S_OK;

end;

function TForm1.DragLeave: HResult;

begin

Result := S_OK;

end;

function TForm1._AddRef: Integer;

begin

Result := 1;

end;

function TForm1._Release: Integer;

begin

Result := 1;

end;

function TForm1.Drop(const dataObj: IDataObject;

grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

var

aFmtEtc: TFORMATETC;

aStgMed: TSTGMEDIUM;

pData: PChar;

begin

{Make certain the data rendering is available}

if (dataObj = nil) then

raise Exception.Create('IDataObject-Pointer is not valid!');

with aFmtEtc do

begin

cfFormat := CF_TEXT;

ptd := nil;

dwAspect := DVASPECT_CONTENT;

lindex := -1;

tymed := TYMED_HGLOBAL;

end;

{Get the data}

OleCheck(dataObj.GetData(aFmtEtc, aStgMed));

try

{Lock the global memory handle to get a pointer to the data}

pData := GlobalLock(aStgMed.hGlobal);

{ Replace Text }

Memo1.Text := pData;

finally

{Finished with the pointer}

GlobalUnlock(aStgMed.hGlobal);

{Free the memory}

ReleaseStgMedium(aStgMed);

end;

Result := S_OK;

end;

end.

Переслать данные в другую программу методом Drag-and-Drop

2017-08-09T19:51:40+07:00

Code:

// Autor: Hagen Reddmann

uses

ShellAPI;

function MakeDrop(const FileNames: array of string): THandle;

// Creates a hDrop Object

// erzeugt ein hDrop Object

var

I, Size: Integer;

Data: PDragInfoA;

P: PChar;

begin

// Calculate memory size needed

// berechne notwendig Speichergro?e

Size := SizeOf(TDragInfoA) + 1;

for I := 0 to High(FileNames) do

Inc(Size, Length(FileNames[I]) + 1);

// allocate the memory

// alloziere den speicher

Result := GlobalAlloc(GHND or GMEM_SHARE, Size);

if Result <> 0 then

begin

Data := GlobalLock(Result);

if Data <> nil then

try

// fill up with data

// fulle daten

Data.uSize := SizeOf(TDragInfoA);

P := PChar(@Data.grfKeyState) + 4;

Data.lpFileList := P;

// filenames at the at of the header (separated with #0)

// am ende des headers nun die filenamen getrennt mit #0

for I := 0 to High(FileNames) do

begin

Size := Length(FileNames[I]);

Move(Pointer(FileNames[I])^, P^, Size);

Inc(P, Size + 1);

end;

finally

GlobalUnlock(Result);

end

else

begin

GlobalFree(Result);

Result := 0;

end;

function MyEnum(Wnd: hWnd; Res: PInteger): Bool; stdcall;

// search for a edit control with classname 'TEditControl'

// suche ein child fenster mit klassennamen 'TEditControl'

var

N: string;

begin

SetLength(N, MAX_PATH);

SetLength(N, GetClassName(Wnd, Pointer(N), Length(N)));

Result := AnsiCompareText('TEditControl', N) <> 0;

if not Result then Res^ := Wnd;

end;

// Example: Open msdos.sys in Delphi's Editor window

// Beispiel: msdos.sys im Delphi Editor offnen

procedure TForm1.Button1Click(Sender: TObject);

var

Wnd: HWnd;

Drop: hDrop;

begin

// search for Delphi's Editor

// suche Delphis Editor Fenster

EnumChildWindows(FindWindow('TEditWindow', nil), @MyEnum, Integer(@Wnd));

if IsWindow(Wnd) then

begin

// Delphi's Editor found. Open msdos.sys

// Delphis editor gefunden, also offne msdos.sys

Drop := MakeDrop(['c:\msdos.sys']);

if Drop <> 0 then PostMessage(Wnd, wm_DropFiles, Drop, 0);

// Free the memory?

// Speicher wieder freigeben?

GlobalFree(Drop);

end;

Реализация Drag-and-Drop из внешнего приложения в ваше

2017-08-09T19:53:12+07:00

Code:

{

The following example demonstrates the Drag&Drop machanism from an external

application (Wordpad, Microsoft,..) to a TMemo in your own application.

}

unit TMemoDragDropFrm;

{ ****************************************************************

Source File Name : TMemoDragDropFrm.pas

Typ : Hauptformular

Autor : Andreas Kosch

Compiler : Delphi 4.02 CSS

Betriebssystem : Windows 98

Beschreibung : Text via OLE Drag&Drop ьbernehmen aus einer

anderen Anwendung (wie zum Beispiel WordPad)

ьbernehmen.

16.01.2003: Test mit Delphi 7 und Microsoft Word XP unter Windowx XP

**************************************************************** }

{ Comments by Thomas Stutz }

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls;

type

// TForm1's declaration indicates that it's a TForm and that

// it supports the IDropTarget interface:

{

IDropTarget

Any application wanting to accept drop operations must

implement the IDropTarget interface.

Methods of the IDropTarget interface:

DragEnter

Dragged item has just been moved into the application's window,

return the relevant icon.

DragOver

Dragged item is being moved over the application's window,

return the relevant icon.

DragLeave

Dragged item has just moved out of the application's window.

Drop

The dragged item has been dropped on this application.

}

TForm1 = class(TForm, IDropTarget)

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

// IDropTarget

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;

// IUnknown

// Ignore referance counting

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

ShellAPI;

// In the OnCreate event handler, two important methods are called.

// First, OleInitalize is called. This initializes the OLE libraries and should always be

// called before your application uses any OLE functions.

// RegisterDragDrop registers the window as a valid drop target.

// If this isn't called, the window will never receive any drop events.

procedure TForm1.FormCreate(Sender: TObject);

begin

OleInitialize(nil);

{Allow window to accept drop events}

OleCheck(RegisterDragDrop(Handle, Self));

{ Execute Wordpad for testing }

ShellExecute(Handle, 'open', 'wordpad', 'c:\Test.doc', nil, SW_SHOW);

end;

// OnDestroy does the exact opposite. It calls RevokeDropTarget to indicate that

// drop events are no longer accepted.

// It then calls OleUninitialize, since the application is finished using all OLE functions.

procedure TForm1.FormDestroy(Sender: TObject);

begin

{Finished accepting drops}

RevokeDragDrop(Handle);

OleUninitialize;

end;

{-----------------------------------------------------------------}

{ IDropTarget-Implementierung }

{-----------------------------------------------------------------}

function TForm1.DragEnter(const dataObj: IDataObject;

grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

begin

dwEffect := DROPEFFECT_COPY;

Result := S_OK;

end;

function TForm1.DragOver(grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

begin

dwEffect := DROPEFFECT_COPY;

Result := S_OK;

end;

function TForm1.DragLeave: HResult;

begin

Result := S_OK;

end;

function TForm1._AddRef: Integer;

begin

Result := 1;

end;

function TForm1._Release: Integer;

begin

Result := 1;

end;

function TForm1.Drop(const dataObj: IDataObject;

grfKeyState: Longint;

pt: TPoint;

var dwEffect: Longint): HResult;

var

aFmtEtc: TFORMATETC;

aStgMed: TSTGMEDIUM;

pData: PChar;

begin

{Make certain the data rendering is available}

if (dataObj = nil) then

raise Exception.Create('IDataObject-Pointer is not valid!');

with aFmtEtc do

begin

cfFormat := CF_TEXT;

ptd := nil;

dwAspect := DVASPECT_CONTENT;

lindex := -1;

tymed := TYMED_HGLOBAL;

end;

{Get the data}

OleCheck(dataObj.GetData(aFmtEtc, aStgMed));

try

{Lock the global memory handle to get a pointer to the data}

pData := GlobalLock(aStgMed.hGlobal);

{ Replace Text }

Memo1.Text := pData;

finally

{Finished with the pointer}

GlobalUnlock(aStgMed.hGlobal);

{Free the memory}

ReleaseStgMedium(aStgMed);

end;

Result := S_OK;

end;

end.