Перетаскивание объектов
Перетаскивание объектов Автор: Павел Свойства DragMode, DragCursor, методы BeginDrag, OnDragOver, OnDragDrop, OnEndDrag, OnStartDrag, параметр Accept Процесс перетаскивания с помощью мыши информации из одного объекта в другой широко используется в Widows.Можно перемещать файлы между папками, перемещать сами папки и др. Все свойства, методы и события, связанные с процессом перетаскивания, определены в классе TControl, являющегося прародителем всех визуальных компонентов Delphi. Поэтому они являются общими для всех компонентов. Начало перетаскивания определяется свойством DragMode, которое может устанавливаться в процессе проектирования или программно равным dmManual или dmAutomatic. Значение dmAutomatic (автоматическое) определяет автоматическое начало процесса перетаскивания при нажатии пользователем кнопки мыши над компонентом. Однако в этом случае событие OnMouseDown, связанное с нажатием пользователем кнопки мыши, для этого компонента вообще не наступает. Значение dmManual (ручное) говорит о том, что начало процесса перетаскивания должен определить программист. Для этого он должен в соответствующий момент вызвать метод BeginDrag. Например, он может поместить вызов этой функции в обработчик события OnMouseDown, наступающего в момент нажатия кнопки мыши. В этом обработчике он может проверить предварительно какие-то условия (режим работы приложения, нажатие тех или иных кнопок мыши и вспомогательнх клавиш) и при выполнении этих условий вызвать BeginDrag. Пусть , например, процесс перетаскавания должен начаться, если пользователь нажал левую кнопку мыши и клавишу Alt над списком ListBox1. Тогда свойство DragMode этого компонента надо установить в dmManual, а его обработчик события OnMouseDown может иметь вид:
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (ssAlt in Shift) then
(Sender as TControl).BeginDrag(false);
end;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
if (Sender as TControl <> Source) then
Accept := Source is TListBox
else
Accept := False;
end;
В нем сначала проверяется, не является ли данный компонент (Sender) и перетаскиваемый объект (Source) одним и тем же объектом. Это сделано, чтобы избежать перетаскивания информации внутри одного и того же списка.
Значение параметра Accept, задаваемое в обрапботчике события onDragOver, определяет вид курсора, перемещающегося при перетаскивании над данным компонентом. Этот вид показывает пользователю, может ли данный компонент принять перетаскиваемую информацию. Если в компоненте не описан обработчик события onDragOver, то считается, что данный компонент, не может принять информацию перетаскиваемого объекта.
Процедура приема информации от перетаскиваемого объекта записывается в обработчике события OnDragDrop принимающего компонента. Это событие наступает, если после перетаскивания пользовательотпустил клавишу мыши над данным компонентом. В обработчик этого события передаются параметры Source (объект-источник) и X и Y координаты курсора. Если продолжить пример перетаскивания информации из одного списка в другой, то обработчик события OnDragDrop может иметь вид:
begin
(Sender as TListBox).Items.Add((Source as TListBox).
Items[(Source as TListBox).ItemIndex]);
end;
В этом обработчике сторка, выделенная в списке-источнике (Source as TListBox).Items[(Source as TListBox).ItemIndex] , добавляется в список-приемник методом (Sender as TListBox).Items.Add. Используется операция AS, позволяющая расссматривать параметры Sender и Source как указатели на объект класса TListBox. Это делается потому, что эти параметры объявлен в заголовке процедуры как указатели на объекты класса TObject. Но в классе TObject нет свойств Items и ItemIndex, которые нам требуются. Эти свойства определены в классе TListBox, являющемся наследником TObject. Поэтому с параметрами Sender и Source в данном случае надо оперировать как с указателями на объекты TListBox, что и выполняет операция as.
В данном случае можно было бы не использовать параметр Sender, заменив (Sender as TListBox) просто на ListBox1. Но запись оператора в общем виде с помощью параметра Sender позволяет воспользоваться таким обработчиком и для других компонентов ListBox, если они имеются в приложении.
После завершения или прерывания перетаскивания наступает событие OnEndDrag, в обработчике которого можно предусмотреть какое-то дополнительное действие. Имеется также связанное с перетаскиванием событие OnStartDrag, которое позволяет произвести какие-то операции в начале перетаскивания, когда иным способом этот момент нельзя зафиксировать.
Таким образом, если в приложении имеется несколько списков и нужно задать возможность копирования строк каждого из этих списков в любой другой, то это потребует двух операций:
Написать для одного списка обработчик события onDragOver. Для всех остальных списков сослаться в событиях onDragOver на этот же обработчик (выделив в форме все оставшиеся списки).
Написать аналогичным образом для всех списков обработчик события OnDragDrop.
Если начинать перетаскивание нужно только при выполнении какого-то дополнительног условия, например, при нажатии клавиши Alt, то потребуется:
Задать для всех списков значение свойства DragMode, равное dmManual и написать обработчик события OnMouseDown.
В приведенном ниже примере:
Многострочный редактор Memo1 готов принять информацию от TLabel и TListBox; списки ListBox готовы принять информацию от всех других списков и при этом, если информация передается не от списка ListBox2, то их списка-источника она удаляется (переносится). Из списка ListBox2 информация только копируется. для метки Label1 c заголовком dmAutomatic определено событие OnEndDrag так, что выводится сообщение об успешном или неуспешном завершении процесса переноса, которое выводится в случае включения флажка с заголовком <Сообщения> :
begin
if CheckBox1.Checked then
if Target = nil then
ShowMessage('Перенесение объекта ' + (Sender as TControl).Name +
' прервано')
else
ShowMessage((Sender as TControl).Name + ' перенесена в ' +
(Target as TControl).Name);
end;
для списков ListBox3 и ListBox4 перетаскивание возможно только при нажатой клавише Alt, но для ListBox4 перетаскивание начинается сразу (значение функции BeginDrag(true)), а для ListBox3 (и метки Label1) момент перетаскивания определяется началом движения мышки (значение функции BeginDrag(false)).
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
Label4: TLabel;
CheckBox1: TCheckBox;
procedure Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ListBox4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
implementation{$R *.DFM}
procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Source is TLabel) or (Source is TListBox);
end;
procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if (Source.ClassName = 'TLabel') then
Memo1.Lines.Add((Source as TLabel).Caption)
else
Memo1.Lines.Add((Source as TListBox).
Items[(Source as TListBox).ItemIndex]);
;
end;
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if (Sender <> Source) then
Accept := Source is TListBox
else
Accept := False;
end;
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
(Sender as TListBox).Items.Add((Source as TListBox).
Items[(Source as TListBox).ItemIndex]);
if (Source as TListBox).Name <> 'ListBox2' then
(Source as TListBox).Items.Delete((Source as TListBox).ItemIndex);
end;
procedure TForm1.ListBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (ssAlt in Shift) then
(Sender as TControl).BeginDrag(false);
end;
procedure TForm1.Label1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
if CheckBox1.Checked then
if Target = nil then
ShowMessage('Перенесение объекта ' + (Sender as TControl).Name +
' прервано')
else
ShowMessage((Sender as TControl).Name + ' перенесена в ' +
(Target as TControl).Name);
end;
procedure TForm1.ListBox4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (ssAlt in Shift) then
(Sender as TListBox).BeginDrag(true);
end;
end.
http://delphiworld.narod.ru/
DelphiWorld 6.0
Отправить комментарий