Перетаскивание объектов, Drag and Drop, Docking

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.

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.

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;

  end;

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;

end;

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;

end;

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.

Code:

var

  Form1: TForm1;

  richcopy: string;

  transfering: boolean;

implementation

{$R *.DFM\}

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

if length(richedit1.seltext)>0 then begin

  richcopy:=richedit1.seltext;

  transfering:=true;

end; //seltext

end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

if transfering then begin

  transfering:=false;

  listbox1.items.add(richcopy);

end; //transfering

end;

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;

end;

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;

end;

Code:

FDragItem := ItematPos(X, Y, True);

if FDragItem >= 0 then

BeginDrag(false);

...

procedure TForm1.ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Source is TDirectoryListBox then

   ListBox.Items.Add(TDirectoryListBox(Source).GetItemPath(FDragItem));

end;