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

Интерфейс присоединения Drag-and-Dock

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

Эта возможность появилась в Delphi 4. Она "подсмотрена" опять-таки у разработчиков из Microsoft, внедривших плавающие панели инструментов в MS Office, Internet Explorer и другие продукты (рис. 27.2).

Речь идет о том, что ряд элементов управления (а конкретно — потомки класса xwinControl) могут служить носителями (доками) для других элементов управления с возможностью их динамического перемещения из одного дока в другой при помощи мыши. Перетаскивать можно практически все — от статического текста до форм включительно. Пример использования техники Drag-and-Dock дает сама среда разработки Delphi — с ее помощью можно объединять на экране различные инструменты, такие как Инспектор объектов и Менеджер проекта.

Как и в случае с технологией перетаскивания Drag-and-Drop, возможны два варианта реализации техники Drag-and-Dock: автоматический и ручной. В первом случае дело сводится к установке нужных значений для нескольких свойств, а остальную часть работы берет на себя код VCL; во втором, как следует из названия, вся работа возлагается на программиста.

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

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.

Drag and Drop из TScrollBox

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

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;

Drag and Drop - как использовать ItemAtPos для получения элемента DirListBox

2017-08-09T19:14:21+07:00

Просто сохраните результат функции ItematPos в переменной формы, и затем используйте эту переменную в обработчике ListBoxDragDrop. Пример:

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;

Drag and Drop TImage

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

Вот рабочий пример. Расположите на форме панель побольше, скопируйте и измените приведенный код так, чтобы изображение загружалось из ВАШЕГО каталога Delphi.

Code:

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

begin

with Source as TImage do

begin

Left := X;

Top := Y;

end;

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

State: TDragState; var Accept: Boolean);

begin

Accept := Source is TImage;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

with TImage.Create(Self) do

begin

Parent := Panel1;

AutoSize := True;

Picture.LoadFromFile('D:\DELPHI\IMAGES\CHIP.BMP');

DragMode := dmAutomatic;

OnDragOver := Panel1DragOver;

OnDragDrop := Panel1DragDrop;

end;

https://delphiworld.narod.ru/

DelphiWorld 6.0

Drag and Drop в TOutline

2017-08-09T19:21:52+07:00

Вам нужно перехватывать в TOutline сообщение wm_DropFiles. Для этого необходимо создать его потомка. Также, вы должны убедиться в том, что дескриптор TOutline Handle хотя бы раз передавался в качестве параметра функции DragAcceptFiles. Для определения положения мыши в момент перетаскивания используется DragQueryPoint. Если вы прочтете разделы в WINAPI.HLP по DragAcceptFiles, wm_DropFiles, DragQueryFile, DragQueryPoint и DragFinish, то вы поймете, как все это работает.

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

Drag and Drop в TTreeView

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

Code:

unit Unit1;

interface

uses

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

ComCtrls;

type

TForm1 = class(TForm)

TreeView1: TTreeView;

procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

private

procedure MoveNode(TargetNode, SourceNode: TTreeNode);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MoveNode(TargetNode, SourceNode: TTreeNode);

var

NodeTmp: TTreeNode;

I: Integer;

begin

with TreeView1 do

begin

// проверяем, является ли целевой элемент предком перетаскиваемого

NodeTmp := TargetNode.Parent;

while Assigned(NodeTmp) do

if NodeTmp = SourceNode then

Abort

else

NodeTmp := NodeTmp.Parent;

// копируем перетаскиваемый элемент в новосозданный

NodeTmp := Items.AddChild(TargetNode, SourceNode.Text);

NodeTmp.Data := SourceNode.Data;

for I := 0 to SourceNode.Count - 1 do

MoveNode(NodeTmp, SourceNode.Item[I]);

Selected := NodeTmp;

TopItem := NodeTmp.getPrev;

TargetNode.Expand(True);

end;

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

var

TargetNode, SourceNode: TTreeNode;

begin

with TreeView1 do

begin

TargetNode := GetNodeAt(X, Y);

SourceNode := Selected;

if (TargetNode = SourceNode) or (TargetNode = nil) then

begin

EndDrag(False);

Exit;

end;

MoveNode(TargetNode, SourceNode);

SourceNode.Free;

end;

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

State: TDragState; var Accept: Boolean);

var

SourceNode, TargetNode, NodeTmp: TTreeNode;

begin

if Sender = TreeView1 then

try

// скроллинг дерева при перетаскивании

if Y > TreeView1.Height - 10 then

begin

TreeView1.TopItem := TreeView1.TopItem.getNext;

Sleep(100); // пауза

end else

if Y < 10 then

begin

TreeView1.TopItem := TreeView1.TopItem.getPrev;

Sleep(100); // пауза

end;

TargetNode := TreeView1.GetNodeAt(X, Y);

SourceNode := TreeView1.Selected;

if (TargetNode = nil) or (TargetNode = SourceNode) then Abort;

Accept := True;

// проверяем, является ли целевой элемент предком перетаскиваемого

NodeTmp := TargetNode.Parent;

while Assigned(NodeTmp) do

if NodeTmp = SourceNode then

Abort

else

NodeTmp := NodeTmp.Parent;

except

Accept := False;

end;

end.

Автор: Smike

Взято из https://forum.sources.ru

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

Drag and Drop для TListBox

2017-08-09T19:13:06+07:00

Drag and Drop для TListBox на примере двойного списка

Автор: Александр Малыгин

Специально для Королевства Delphi

Типичная задача перетаскивания мышью объектов из одного контрола в другой просто решается обработкой событий OnDragOver и OnDragDrop, при установленных свойствах DragMode := dmAutomatic и DragKind := dkDrag у всех участвующих компонентов.

Первый обработчик предназначен для принятия решения - допускается ли сбросить объект в контрол, над которым находится мышь (параметр Sender), и выставить соответствующий курсор. Для этого передается параметр Source:TObject, представляющий собой тот компонент, с которого начали перетаскивание (источник), координаты курсора X,Y:integer, состояние процесса перетаскивания State:TDragState, и результат, который надо вернуть var Accept:boolean.

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

Drag and Drop из RichEdit

2017-08-09T19:15:14+07:00

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;

Drag and Drop несколько элементов в TListView

2017-08-09T19:17:20+07:00

Code:

{ ListView1.DragMode := dmAutomatic }

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

var

DragItem, DropItem, CurrentItem, NextItem: TListItem;

begin

if Sender = Source then

with TListView(Sender) do

begin

DropItem := GetItemAt(X, Y);

CurrentItem := Selected;

while CurrentItem <> nil do

begin

NextItem := GetNextItem(CurrentItem, SdAll, [IsSelected]);

if DropItem = nil then DragItem := Items.Add

else

DragItem := Items.Insert(DropItem.Index);

DragItem.Assign(CurrentItem);

CurrentItem.Free;

CurrentItem := NextItem;

end;

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

State: TDragState;

var Accept: Boolean);

begin

Accept := Sender = ListView1;

end;

Drag and Drop со списками

2017-08-09T19:18:10+07:00

Code:

{

This example shows how to drag&drop within a TListBox.

The Demo Program also shows how to implement an autoscroll-feature.

}

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

State: TDragState; var Accept: Boolean);

begin

Accept := Sender is TListBox;

end;

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

var

iTemp: Integer;

ptTemp: TPoint;

szTemp: string;

begin

{ change the x,y coordinates into a TPoint record }

ptTemp.x := x;

ptTemp.y := y;

{ Use a while loop instead of a for loop due to items possible being removed

from listboxes this prevents an out of bounds exception }

iTemp := 0;

while iTemp <= TListBox(Source).Items.Count-1 do

begin

{ look for the selected items as these are the ones we wish to move }

if TListBox(Source).selected[iTemp] then

begin

{ use a with as to make code easier to read }

with Sender as TListBox do

begin

{ need to use a temporary variable as when the item is deleted the

indexing will change }

szTemp := TListBox(Source).Items[iTemp];

{ delete the item that is being dragged }

TListBox(Source).Items.Delete(iTemp);

{ insert the item into the correct position in the listbox that it

was dropped on }

Items.Insert(itemAtPos(ptTemp, True), szTemp);

end;

Inc(iTemp);

end;

Заполнение полей формы в TWebBrowser методом Drag-and-Drop

2017-08-09T19:23:31+07:00

Code:

{

This example shows how to fill out fields in your webbrowser by

dragging the content of Label1 to a field of your webbrowser}

procedure TForm1.FormCreate(Sender: TObject);

begin

label1.DragMode := dmAutomatic;

end;

procedure TForm1.WebBrowserDragOver(Sender, Source: TObject; X,

Y: Integer; State: TDragState; var Accept: Boolean);

var

item: Variant;

begin

//check if document is interactive

if (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then

begin

item := WebBrowser.OleObject.Document.elementFromPoint(x, y);

if Source is TLabel then

Accept := True;

Accept := (item.tagname = 'INPUT') and ((item.type = 'text') or

(item.type = 'password')) or (item.tagname = 'TEXTAREA');

end;

procedure TForm1.WebBrowserDragDrop(Sender, Source: TObject; X,

Y: Integer);

var

item: Variant;

begin

//check if document is interactive

if (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then

begin

item := WebBrowser.OleObject.Document.elementFromPoint(x, y);

item.Value := label1.Caption;

end;

Как перетаскивать (Drag and Drop) выделенный текст между компонентами Memo?

2017-08-09T18:57:17+07:00

Данный способ позволяет не погружаясь глубоко в создание компонент осуществить операцию "drag and drop" выделенного текста.

Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:

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

Как перетаскивать выделенный текст между компонентами Memo

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

Создайте новый компонент (TMyMemo), наследовав его от TMemo. И объявите его следующим образом:

Code:

type

TMyMemo = class(TMemo)

private

FLastSelStart : Integer;

FLastSelLength : Integer;

procedure WMLButtonDown(var message: TWMLButtonDown); message WM_LBUTTONDOWN;

published

property LastSelStart : Integer read FLastSelStart write FLastSelStart;

property LastSelLength : Integer read FLastSelLength write FLastSelLength;

end;

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

Как перетаскивать компоненты в Run-Time?

2017-08-09T18:59:46+07:00

Возьмите форму, бросьте на нее панель, на onMouseDown панели прицепите код:

Code:

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

Shift: TShiftState; X, Y: Integer);

begin

ReleaseCapture;

Panel1.Perform(WM_SYSCOMMAND, $F012, 0);

end;

Теперь в run-time панель можно таскать как в дизайне...

Взято с Vingrad.ru https://forum.vingrad.ru

Как перетащить целую колонку из StringGrid в ListBox

2017-08-09T19:26:04+07:00

В Object Inspector установите свойство dragmode у StringGrid в dmAutomatic.

Ниже приведён полный код:

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

Перестроить вкладки TPageControl с помощью Drag and Drop

2017-08-09T18:54:17+07:00

Code:

// In the PageControl's OnMouseDown event handler:

procedure TForm1.PageControl1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

PageControl1.BeginDrag(False);

end;

// In the PageControl's OnDragDrop event handler:

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

const

TCM_GETITEMRECT = $130A;

var

i: Integer;

r: TRect;

begin

if not (Sender is TPageControl) then Exit;

with PageControl1 do

begin

for i := 0 to PageCount - 1 do

begin

Perform(TCM_GETITEMRECT, i, lParam(@r));

if PtInRect(r, Point(X, Y)) then

begin

if i <> ActivePage.PageIndex then

ActivePage.PageIndex := i;

Exit;

end;

// In the PageControl's OnDragOver event handler:

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X,

Y: Integer; State: TDragState; var Accept: Boolean);

begin

if Sender is TPageControl then

Accept := True;

end;

Взято с https://delphiworld.narod.ru

Пример Drag and Drop между двумя DBGRID

2017-08-09T19:27:11+07:00

Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.

Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).

Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.

Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.

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

Примеры использования Drag and Drop для различных визуальных компонентов

2017-08-09T18:46:40+07:00

Перетаскивание информации с помощью мыши стало стандартом для программ, работающих в Windows. Часто это бывает удобно и позволяет добиться более быстрой работы. В данной статье я постарался показать максимальное количество примеров использования данной технологии при разработке приложений в среде Delphi. Конечно, результат может быть достигнут различными путями, продемонстрированные приемы не являются единственными и, возможно, не всегда самые оптимальные, но вполне работоспособны, и указывают направление поиска. Надеюсь, что они побудят начинающих программистов к более широкому использованию Drag'n'Drop в своих программах, тем более что пользователи, особенно неопытные, быстро привыкают к перетаскивание и часто его применяют.

Проще всего делать Drag из тех компонентов, для которых однозначно ясно, что именно перетаскивать. Для этого устанавливаем у источника DragMode = dmAutomatic, а у приемника пишем обработчики событий OnDragOver - разрешение на прием, и OnDragDrop - действия, производимые при окончании перетаскивания.

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

Прокручивать TTreeView во время перемещения

2017-08-09T19:05:26+07:00

Code:

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

State: TDragState; var Accept: Boolean);

begin

if (y < 15) then {On the upper edge - should scroll up }

SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEUP, 0)

else if (TreeView1.Height - y < 15) then { On the lower edge - should scroll down }

SendMessage(TreeView1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);

end;

Внутренний интерфейс Drag and Drop

2017-08-09T18:21:41+07:00

Для библиотеки VCL фирмой Borland реализована собственная версия интерфейса Drag&Drop (переводится как "перетащить"). Интерфейс этот внутренний — передавать и принимать можно любые управляющие элементы Delphi внутри формы' (кроме самой формы). Он реализован без использования соответствующих функций API Windows — их нужно применять при организации общения с другими задачами путем перетаскивания.

Нажав левую кнопку мыши над элементом управления, мы можем "перетащить" его на любой другой элемент. С точки зрения программиста это означает, что в моменты перетаскивания и отпускания клавиши генерируются определенные события, которыми передается вся необходимая информация — указатель на перетаскиваемый объект, текущие координаты курсора и др. Получателем событий является тот элемент, на котором в данный момент находится курсор. Обработчик такого события должен сообщить системе, принимает ли данньш элемент управления "посылку" или нет. При отпускании кнопки над принимающим элементом управления генерируется еще одно или два события, в зависимости от готовности приемника.

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

Интерфейс переноса Drag-and-Drop

2017-08-09T18:28:56+07:00

Интерфейс переноса и приема компонентов появился достаточно давно. Он обеспечивает взаимодействие двух элементов управления во время выполнения приложения. При этом могут выполняться любые необходимые операции. Несмотря на простоту реализации и давность разработки, многие программисты (особенно новички) считают этот механизм малопонятным и экзотическим. Тем не менее использование Drag-and-Drop может оказаться очень полезным и простым в реализации. Сейчас мы в этом убедимся.

Для того чтобы механизм заработал, требуется настроить соответствующим образом два элемента управления. Один должен быть источником (Source), второй — приемником (Target). При этом источник никуда не перемещается, а только регистрируется в качестве такового в механизме.

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

Перетаскивание объектов

2017-08-09T18:36:47+07:00

Автор: Павел

Свойства DragMode, DragCursor, методы BeginDrag, OnDragOver, OnDragDrop, OnEndDrag, OnStartDrag, параметр Accept

Процесс перетаскивания с помощью мыши информации из одного объекта в другой широко используется в Widows.Можно перемещать файлы между папками, перемещать сами папки и др.

Все свойства, методы и события, связанные с процессом перетаскивания, определены в классе TControl, являющегося прародителем всех визуальных компонентов Delphi. Поэтому они являются общими для всех компонентов.

Начало перетаскивания определяется свойством DragMode, которое может устанавливаться в процессе проектирования или программно равным dmManual или dmAutomatic. Значение dmAutomatic (автоматическое) определяет автоматическое начало процесса перетаскивания при нажатии пользователем кнопки мыши над компонентом. Однако в этом случае событие OnMouseDown, связанное с нажатием пользователем кнопки мыши, для этого компонента вообще не наступает.

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

Преобразование координат в параметрах событий OnDragOver и OnDragDrop, в координаты формы

2017-08-09T18:38:33+07:00

Автор: Neil

Поверьте, достаточно просто преобразовать X,Y координаты, передаваемые в параметрах событий OnDragOver и OnDragDrop, в координаты формы.

Работайте со свойствами Left и Top компонента, над которым перемещается курсор. Приведу простой пример. Поместите на форму компонент Memo и присвойте свойству Align значение alTop. Поместите на форму панель, также присвойсте свойству Align значение alTop и задайте небольшое значение свойству Height, скажем 6 или 7 пикселей. Установите DragMode на dmAutomatica и DragCursor на crVSplit. Поместите другой Memo-компонент и установите Align на alClient. Одновременно выберите оба Memo-компонента, панель и создайте общий обработчик события OnDragOver как показано ниже:

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

Функции и процедуры для работы с drag-and-drop операциями

2017-08-09T18:25:05+07:00

CancelDrag Отменяет текущую drag-and-drop или drag-and-dock операцию.

Функция FindDragTarget (const Pos: TPoint;AllowDisabled: Boolean ): TControl;

Функция возвращает объект базового класса TControl, к которому относится позиция экрана с координатами, определенными параметром Pos. Данная функция используется для определения потенциального получателя drag-and-drop или drag-and-dock операции. Если для указанной позиции не существует никакого оконного средства управления, то функция возвращает nil. Параметр AllowDisabled определяет, будут ли учитываться заблокированные (disabled) объекты.

Функция IsDragObject( Sender: TObject ): Boolean;

Функция определяет, является ли объект, определенный в параметре Sender, потомком класса TDragObject. Данную функцию можно использовать в качестве параметра Source в обработчиках событий OnDragOver и OnDockOver для того, чтобы определить будет ли принят перетаскиваемый объект. Также функцию IsDragObject можно использовать в качестве параметра Source в обработчиках событий OnDragDrop и OnDockDrop для того, чтобы правильно интерпретировать перетаскиваемый объект.

Как перемещать компонент во время работы программы

2017-08-09T20:04:26+07:00

Автор: Олег Кулабухов

Нижеприведенный пример показывает как перемещать компонент при перетаскивании его нажатой левой кнопкой мыши при нажатом Ctrl.

Code:

procedure TForm1.Button1MouseDown(Sender: TObject; Button:

TMouseButton; Shift: TShiftState; X, Y: Integer);

{$IFNDEF WIN32}

var

pt: TPoint;

{$ENDIF}

begin

if ssCtrl in Shift then

begin

ReleaseCapture;

SendMessage(Button1.Handle, WM_SYSCOMMAND, 61458, 0);

{$IFNDEF WIN32}

GetCursorPos(pt);

SendMessage(Button1.Handle,

WM_LBUTTONUP,

MK_CONTROL,

Longint(pt));

{$ENDIF}

end;

Как таскать форму за метку?

2017-08-09T20:03:14+07:00

Code:

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

Shift: TShiftState; X, Y: Integer);

const SC_DragMove = $F012; { a magic number }

begin

ReleaseCapture;

Form1.perform(WM_SysCommand, SC_DragMove, 0);

end;

Автор ответа: TAPAKAH

Взято с Vingrad.ru https://forum.vingrad.ru

Перемещение изображений по форме с помощью мыши

2017-08-09T20:06:35+07:00

Автор: Павел

Во время работы над одной программой предо мной встала задача организации перемещения нескольких изображений пользователем с помощью мыши. Я не крутой мастер DELPHI, и найденное мною решение не претендует на полноту, его недостатки я рассмотрю ниже, но я надеюсь, что опыт, приобретённый при решении будет полезен читателю.

Итак, задача. На форме размещены несколько изображений, загружаемых из внешних файлов (их имена 1.bmp, 2.bmp и т.д.).

Изображения должны быть перемещаемыми с помощью мыши.

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