Drag and Drop sample/ru
│
English (en) │
русский (ru) │
Перетаскивание и бросание элементов интерфейса - это обычная операция, которая делает интерфейс удобным для пользователя: пользователь может перетаскивать информацию в элементы управления вместо того, чтобы вводить и т.д.
В следующем примере объясняются основы перетаскивания. Для получения подробной информации обратитесь к другим статьям вики и справочной документации.
Обратите внимание, поскольку LCL частично совместим с Delphi VCL, некоторые статьи/примеры о перетаскивании Delphi могут также относиться к LCL.
Drag and Drop
Несмотря на простоту работы с точки зрения пользователя, неопытному разработчику она может доставить немало хлопот.
Для кода операция перетаскивания всегда состоит как минимум из трех шагов:
- Некоторый элемент управления запускает операцию перетаскивания. Он называется Source (Источником)
- Пользователь таскает курсор мыши над другими элементами управления или над самим источником. Теперь перетаскиваемый элемент управления должен решить, может ли он принимать перетаскиваемые данные.
- Бросание происходит, если элемент управления соглашается принять перетаскиваемые данные. Принимающий элемент управления называется Sender (Приемник).
Для упрощения перетаскивания в LCL предусмотрен «автоматический» режим. Это не означает, что LCL выполняет все операции перетаскивания за вас, но он будет обрабатывать низкоуровневое управление объектами перетаскивания (которое не рассматривается в этой статье).
Примеры
Пример охватывает функцию автоматического перетаскивания между двумя элементами управления (Edit->Treeview), а также внутри одного элемента управления (Treeview->Treeview).
- Запустите новое приложение.
- Поместите компонент TreeView и Edit в форму.
- Включите автоматический режим перетаскивания (Automatic drag-and-drop) для TreeView и редактирования в инспекторе объектов:
DragMode: dkAutomatic
Теперь вы можете запустить приложение и попробовать перетащить что-нибудь. У вас пока не должно ничего работать. Но если вы нажмете левую кнопку мыши в Treeview, вы, вероятно, увидите, что значок курсора изменился, но при отпускании мыши ничего не происходит.
Перетаскивание между элементами управления
Сделаем операцию перетаскивания между Edit и TreeView. Там содержимое Edit будет «перетащено» в TreeView и будет создан новый узел дерева.
Чтобы инициировать перетаскивание, у элементов управления есть специальный метод: BeginDrag()
Создайте событие OnMouseDown для Edit:
procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then {проверяем, была ли нажата левая кнопка мыши}
Edit1.BeginDrag(true); {начинаем операцию перетаскивания}
end;
Если вы запустите приложение прямо сейчас и попытаетесь перетащить его, вы заметите, что Edit запускает операцию, но по-прежнему ничего не происходит, когда вы пытаетесь тащить элемент к TreeView.
Это потому, что TreeView не принимает данные. Ни один из элементов управления не принимает данные по умолчанию, поэтому вам всегда нужно предоставлять соответствующий обработчик событий.
Создайте код в событии TreeView.OnDragOver:
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := true;
end;
Конечно, в некоторых случаях TreeView может запретить перетаскивание (если Source или данные не могут быть обработаны), но на данный момент TreeView всегда принимает перетаскивание.
Запустите приложение и протестируйте. Теперь все должно быть лучше, хотя при бросании элемента все равно ничего не происходит.
Создайте код в событии TreeView.OnDragDrop:
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
tv : TTreeView;
iNode : TTreeNode;
begin
tv := TTreeView(Sender); { Sender - это TreeView, где данные удаляются }
iNode := tv.GetNodeAt(x,y); { х, y - координаты перетаскивания (относительно Sender) }
{ поскольку Sender - это TreeView, мы можем оценить }
{ дерево в координатах X, Y }
{ TreeView также может быть Source'ом! Так что мы должны убедиться, }
{ что этим Source'ом является TEdit, до получения им текста }
if Source is TEdit then
tv.Items.AddChild(iNode, TEdit(Source).Text); {Теперь мы можем добавить новый узел с текстом из Source }
end;
Запускаем и тестируем. Теперь он должен работать. Перетаскивание текста из Edit в TreeView должно создать новый узел.
Перетаскивание внутри элемента управления
Sender и Source могут быть одним и тем же элементом управления! Это ни в коем случае не запрещено. Давайте добавим возможность TextView изменять расположение его узлов.
Поскольку TextView находится в автоматическом режиме DragMode, вам не нужно начинать перетаскивание с помощью DragBegin(). Он запускается автоматически при перемещении мыши с удержанием левой кнопки.
Убедитесь, что у вас "Accept:=true;" внутри операции DragOver для источника TreeView.
Измените обработчик события DragDrop следующим образом:
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
tv : TTreeView;
iNode : TTreeNode;
begin
tv := TTreeView(Sender); { Sender - это TreeView, где данные удаляются }
iNode := tv.GetNodeAt(x,y); { х, y - координаты перетаскивания (относительно Sender) }
{поскольку Sender - это TreeView, мы можем оценить }
{ дерево в координатах X, Y }
{ TreeView также может быть Source'ом! Так что мы должны убедиться, }
{ что этим Source'ом является TEdit, до получения им текста }
if Source is TEdit then
tv.Items.AddChild(iNode, TEdit(Source).Text) {Теперь мы можем добавить новый узел с текстом из Source }
else if Source = Sender then begin { бросание элемента интерфейса происходит внутри TreeView }
if Assigned(tv.Selected) and { проверяем, был ли выбран какой-либо узел }
(iNode <> tv.Selected) then { и мы переходим к другому узлу }
begin
if iNode <> nil then
tv.Selected.MoveTo(iNode, naAddChild) { завершаем операцию перетаскивания, переместив выбранный узел }
else
tv.Selected.MoveTo(iNode, naAdd); { завершаем операцию перетаскивания, переместившись в корень TreeView }
end;
end;
end;
Вот и все. Если вы запустите приложение сейчас, у вас должны работать обе функции.
- Добавление нового узла путем перетаскивания текста из Edit в TreeView
- Перетаскивание узлов внутри древовидной структуры
Подсказки
- Можете (не можете) ли вы использовать некоторые глобальные данные, чтобы проверить, что сейчас перетаскивается? Используйте для этого не глобальные переменные, а только поля вашего класса формы.
- Помещайте туда данные при запуске перетаскивания
- Проверяйте данные во время перетаскивания элемента управления и соответствующим образом изменяйте Accept-флаг элемента .
- Читайте и используйте данные в событии перетаскивания
Перетаскивание из других приложений
Вы можете перетащить/отпустить
Файлы
Файлы можно легко бросать и обрабатывать, реализуя событие FormDropFiles после того, как для формы свойство AllowDropFiles задано как True:
procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String);
var FileName : String;
begin
for FileName in FileNames do
begin
ShowMessage(FileName);
end;
end;
Прим.перев.: Наиболее наглядно пример реализован здесь.
Текст и т.д.
Вы можете перетащить, например текст из другого приложения (например, блокнота) в элемент управления в вашем приложении. Способ реализации зависит от платформы.
Windows
Этот код позволяет перетаскивать выделенный текст из других приложений в элемент управления редактированием.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Windows, ActiveX, ComObj;
type
{ TForm1 }
TForm1 = class(TForm, IDropTarget)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
// IDropTarget
function DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;StdCall;
function DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult;StdCall;
function DragLeave: HResult;StdCall;
function Drop(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD):HResult;StdCall;
// IUnknown
// Ignore referance counting
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
OleInitialize(nil);
OleCheck(RegisterDragDrop(Handle, Self));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RevokeDragDrop(Handle);
OleUninitialize;
end;
function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: DWORD;
pt: TPoint; var dwEffect: DWORD): HResult; StdCall;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
function TForm1.DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD
): HResult; StdCall;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
function TForm1.DragLeave: HResult; StdCall;
begin
Result := S_OK;
end;
function TForm1._AddRef: Integer; stdcall;
begin
Result := 1;
end;
function TForm1._Release: Integer; stdcall;
begin
Result := 1;
end;
function TForm1.Drop(const dataObj: IDataObject; grfKeyState: DWORD;
pt: TPoint; var dwEffect: DWORD): HResult; StdCall;
var
aFmtEtc: TFORMATETC;
aStgMed: TSTGMEDIUM;
pData: PChar;
begin
{Убеждаемся, что рендеринг данных доступен}
if (dataObj = nil) then
raise Exception.Create('IDataObject-Указатель недействителен!');
with aFmtEtc do
begin
cfFormat := CF_TEXT;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
{Получаем данные}
OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
try
{Заблокируем дескриптор глобальной памяти, чтобы получить указатель на данные}
pData := GlobalLock(aStgMed.hGlobal);
{ Заменяем текст }
Memo1.Text := pData;
finally
{Завершаем с указателем}
GlobalUnlock(aStgMed.hGlobal);
{Освобождаем память}
ReleaseStgMedium(aStgMed);
end;
Result := S_OK;
end;
end.
Источник на форуме: этот тред
