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

=== Примеры использования Drag and Drop для различных визуальных компонентов ===
Перетаскивание информации с помощью мыши стало стандартом для программ, работающих в Windows. Часто это бывает удобно и позволяет добиться более быстрой работы. В данной статье я постарался показать максимальное количество примеров использования данной технологии при разработке приложений в среде Delphi. Конечно, результат может быть достигнут различными путями, продемонстрированные приемы не являются единственными и, возможно, не всегда самые оптимальные, но вполне работоспособны, и указывают направление поиска. Надеюсь, что они побудят начинающих программистов к более широкому использованию Drag'n'Drop в своих программах, тем более что пользователи, особенно неопытные, быстро привыкают к перетаскивание и часто его применяют. 
Проще всего делать Drag из тех компонентов, для которых однозначно ясно, что именно перетаскивать. Для этого устанавливаем у источника DragMode = dmAutomatic, а у приемника пишем обработчики событий OnDragOver - разрешение на прием, и OnDragDrop - действия, производимые при окончании перетаскивания. 
procedure TForm1.StringGrid2DragOver(Sender, Source: TObject; X,
 Y: Integer; State: TDragState; var Accept: Boolean);
begin
 Accept := Source = Edit1;
 // разрешено перетаскивание только из Edit1,
 // при работе программы меняется курсор
end;
procedure TForm1.StringGrid2DragDrop(Sender, Source: TObject; X, Y: Integer);
var
 ACol, ARow: Integer;
begin
 StringGrid2.MouseToCell( X, Y, ACol, ARow);
 // находим, над какой ячейкой произвели Drop
 StringGrid2.Cells[ Acol, Arow] := Edit1.Text;
 // записываем в нее содержимое Edit1
end;
Теперь рассмотрим копирование в упорядоченный список ListBox1 из другого списка. В OnDragOver проверяем, выбран ли хоть один элемент в источнике: 
Accept := (Source = ListBox2) and (ListBox2.ItemIndex >= 0);
В OnDragDrop ищем отмеченные в источнике строки (установлен множественный выбор) и добавляем только те, которых еще нет в приемнике: 
for i := 0 to ListBox2.Items.Count - 1 do
 if (ListBox2.Selected[i]) and (ListBox1.Items.IndexOf(ListBox2.Items[i]) < 0) then
 ListBox1.Items.Add(ListBox2.Items[i]);
Для ListBox2 реализуем перенос строк из ListBox1 и перестановку элементов в желаемом порядке. В OnDragOver разрешаем Drag из любого ListBox: 
Accept := (Source is TListBox) and ((Source as TListBox).ItemIndex >= 0);
А OnDragDrop будет выглядеть так: 
var
 s: string;
begin
 if Source = ListBox1 then
 begin
 ListBox2.Items.Add(ListBox1.Items[ListBox1.ItemIndex]);
 // удаляем перенесенный элемент
 ListBox1.Items.Delete(ListBox1.ItemIndex);
 end
 else // внутренняя перестановка
 begin
 s := ListBox2.Items[ListBox2.ItemIndex];
 ListBox2.Items.Delete(ListBox2.ItemIndex);
 // находим, в какую позицию переносить и вставляем
 ListBox2.Items.Insert(ListBox2.ItemAtPos(Point(X, Y), False), s);
 end;
end;
Научимся переносить текст в Memo, вставляя его в нужное место. Поскольку я выбрал в качестве источника любой из ListBox, подключим в Инспекторе Объектов для OnDragOver уже написанный ранее обработчик ListBox2DragOver, а в OnDragDrop напишем 
if not CheckBox1.Checked then // при включении добавляется в конец текста
begin
 // устанавливаем позицию вставки согласно координатам мыши
 Memo1.SelStart := LoWord(Memo1.Perform(EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
 Memo1.SelText := TListBox(Source).Items[TListBox(Source).ItemIndex];
end
else
 memo1.lines.add(TListBox(Source).Items[TListBox(Source).ItemIndex]);
Замечу, что для RichEdit EM_CHARFROMPOS работает несколько иначе, что продемонстрировано в следующем примере. Перенос из Memo реализован с помощью правой кнопки мыши, для того, чтобы не изменять стандартное поведение Memo, и поскольку нажатие левой кнопки снимает выделение. Для Memo1 установлено DragMode = dmManual, а перетаскивание инициируется в OnMouseDown 
if (Button = mbRight) and (Memo1.SelLength > 0) then Memo1.BeginDrag(True);
Обработчик RichEdit1DragOver очевиден, а в RichEdit1DragDrop пишем 
var
 p: tpoint;
begin
 if not CheckBox1.Checked then
 begin
 p := point(x, y);
 RichEdit1.SelStart := RichEdit1.Perform(EM_CHARFROMPOS, 0, Integer(@P));
 RichEdit1.SelText := Memo1.SelText;
 end
 else
 RichEdit1.Lines.Add(Memo1.SelText);
end;
Рассмотрим теперь перетаскивание в ListView1 (ViewStyle = vsReport). В OnDragOver разрешим прием из ListBox2 и из себя же: 
Accept := ((Source = ListBox2) and (ListBox2.ItemIndex >= 0)) or (Source = Sender);
А вот OnDragDrop теперь будет посложнее 
var
 Item, CurItem: TListItem;
begin
 if Source = ListBox2 then
 begin
 Item := ListView1.DropTarget;
 if Item <> nil then
 begin
 // случай перетаскивания на Caption
 if Item.SubItems.Count = 0 then
 // добавляем SubItem, если их еще нет
 Item.SubItems.Add(ListBox2.Items[ListBox2.ItemIndex])
 else
 // иначе заменяем имеющийся SubItem
 Item.SubItems[0] := ListBox2.Items[ListBox2.ItemIndex]
 end
 else
 begin
 // при перетаскивании на пустое место создаем новый элемент
 Item := ListView1.Items.Add;
 Item.Caption := ListBox2.Items[ListBox2.ItemIndex];
 end;
 end
 else // случай внутренней перестановки
 begin
 // запомним выбранный элемент
 CurItem := ListView1.Selected;
 // другой метод определения элемента на который делаем Drop
 Item := ListView1.GetItemAt(x, y);
 if Item <> nil then
 // вставляем новый элемент перед найденным
 Item := ListView1.Items.Insert(Item.Index)
 else
 // или добавляем новый элемент в конец
 Item := ListView1.Items.Add;
 // копируем исходный в новый
 Item.Assign(CurItem);
 // уничтожаем исходный
 CurItem.Free;
 end;
end;
Для ListView2 установим ViewStyle = vsSmallIcon и покажем, как вручную расставлять значки. В OnDragOver зададим условие 
// пересечение множеств должно быть пустым - запрещаем накладывать элементы
Accept := (Sender = Source) and
 ([htOnLabel,htOnItem, htOnIcon] * ListView2.GetHitTestInfoAt(x, y) = []); 
а код в OnDragDrop очень простой: 
ListView2.Selected.SetPosition(Point(X, Y));
Перетаскивание в TreeView - довольно любопытная тема, здесь порой приходится разрабатывать алгоритмы обхода ветвей для достижения желаемого поведения. Для TreeView1 разрешим перестановку своих узлов в другое положение. В OnDragOver проверим, не происходит ли перетаскивание узла на свой же дочерний во избежание бесконечной рекурсии: 
var
 Node, SelNode: TTreeNode;
begin
 // находим узел-приемник
 Node := TreeView1.GetNodeAt(x, y);
 Accept := (Sender = Source) and (Node <> nil);
 if not Accept then
 Exit;
 SelNode := Treeview1.Selected;
 while (Node.Parent <> nil) and (Node <> SelNode) do
 begin
 Node := Node.Parent;
 if Node = SelNode then
 Accept := False;
 end;
Код OnDragDrop выглядит так: 
var
 Node, SelNode: TTreeNode;
begin
 Node := TreeView1.GetNodeAt(X, Y);
 if Node = nil then
 Exit;
 // все уже встроено в TreeView
 SelNode := TreeView1.Selected;
 SelNode.MoveTo(Node, naAddChild);
end;
Теперь разрешим перенос в TreeView2 из TreeView1 
Accept := (Source = TreeView1) and (TreeView2.GetNodeAt(x, y) <> nil);
И в OnDragDrop копируем выбранную в TreeView1 ветвь во всеми подветвями, для чего придется сделать рекурсивный обход: 
var
 Node: TTreeNode;
 procedure CopyNode(FromNode, ToNode: TTreeNode);
 var
 TempNode: TTreeNode;
 i: integer;
 begin
 TempNode := TreeView2.Items.AddChild(ToNode, );
 TempNode.Assign(FromNode);
 for i := 0 to FromNode.Count - 1 do
 CopyNode(FromNode.Item[i], TempNode);
 end;
begin
 Node := TreeView2.GetNodeAt(X, Y);
 if Node = nil then
 Exit;
 CopyNode(TreeView1.Selected, Node);
end;
Рассмотрим теперь перенос ячеек в StringGrid1. Поскольку, как и в случае с Memo, простое нажатие левой кнопки занято под другие действия, установим DragMode = dmManual и будем запускать Drag при нажатии левой кнопки, удерживая клавиши Alt или Ctrl. Запишем в OnMouseDown: 
var
 Acol, ARow: Integer;
begin
 with StringGrid1 do
 if (ssAlt in Shift) or (ssCtrl in Shift) then
 begin
 MouseToCell(X, Y, Acol, Arow);
 // не будем перетаскивать из фиксированных ячеек
 if (Acol >= FixedCols) and (Arow >= FixedRows) then
 begin
 if ssAlt in Shift then
 Tag := 1
 else
 // запомним что нажато - Alt или Ctrl - в Tag StringGrid1
 if ssCtrl in Shift then
 Tag := 2;
 BeginDrag(True)
 end
 else
 Tag := 0;
 end;
end;
Код OnDragOver учитывает также возможность перетаскивания из StringGrid2 (описание ниже) 
var
 Acol, ARow: Integer;
begin
 with StringGrid1 do
 begin
 MouseToCell(X, Y, Acol, Arow);
 Accept := (Acol >= FixedCols) and (Arow >= FixedRows)
 and (((Source = StringGrid1) and (Tag > 0))
 or (Source = StringGrid2));
 end;
Часть OnDragDrop, относящаяся к внутреннему переносу: 
var
 ACol, ARow, c, r: Integer;
 GR: TGridRect;
begin
 StringGrid1.MouseToCell(X, Y, ACol, ARow);
 if Source = StringGrid1 then
 with StringGrid1 do
 begin
 // копируем ячейку-источник в приемник
 Cells[Acol, Arow] := Cells[Col,Row];
 // очищаем источник, если было нажато Alt
 if Tag = 1 then
 Cells[Col,Row] := ;
 Tag := 0;
 end;
А вот из StringGrid2 сделаем перенос выбранного диапазона ячеек с помощью правой кнопки, для этого в OnMouseDown 
if Button = mbRight then StringGrid2.BeginDrag(True);
И теперь часть StringGrid1DragDrop, относящаяся к переносу из StringGrid2: 
if Source = StringGrid2 then
 begin
 // Selection - выделенные в StringGrid2 ячейки
 GR := StringGrid2.Selection;
 for r := 0 to GR.Bottom - GR.Top do
 begin
 for c := 0 to GR.Right - GR.Left do
 begin
 // застрахуемся от записи вне StringGrid1
 if (ACol + c < StringGrid1.ColCount) and
 (ARow + r < StringGrid1.RowCount) then
 StringGrid1.Cells[ACol + c, ARow + r] :=
 StringGrid2.Cells[c + GR.Left, r + GR.Top];
 end;
 end;
 end;
Теперь покажем, как этот диапазон ячеек из StringGrid2 перенести в Memo2. Для этого в OnDragOver Memo2 пишем: 
Accept := (Source = StringGrid2) or (Source = DBGrid1);
и в OnDragDrop Memo2: 
var
 c, r: integer;
 s: string;
begin
 Memo2.Clear;
 if Source = StringGrid2 then
 begin
 with StringGrid2 do
 begin
 for r := Selection.Top to Selection.Bottom do
 begin
 s := ;
 // разделим ячейки табуляцией
 for c := Selection.Left to Selection.Right do
 s := s + Cells[c, r] + #9;
 memo2.lines.add(s);
 end;
 end;
 end;
Кроме того, в Memo2 можно переносить выбранную запись из DBGrid1, у которого установлено в Options dgRowSelect = True. В сетке отображается таблица из стандартной поставки Delphi DBDEMOS - Animals.dbf. Перетаскивание осуществляется аналогично StringGrid2, правой кнопкой мыши, только по событию OnMouseMove 
 if ssRight in Shift then 
 DBGrid1.BeginDrag(true);
 // Код в Memo2DragDrop, относящийся к переносу из DBGrid1: 
 else
 with DBGrid1.DataSource.DataSet do
 begin
 s := ;
 for c := 0 to FieldCount - 1 do
 s := s + Fields[c].AsString + ' | ';
 memo2.lines.add(s);
 end;
 // в случае dgRowSelect = False для переноса одного поля достаточно сделать
 // memo2.lines.add(DbGrid1.SelectedField.AsString);
Drag из DBGrid1 принимается также на Panel3, условие приема очевидно, а OnDragDrop выглядит так: 
 Panel3.Height := 300; // раскрываем панель
 Image1.visible := True;
 OleContainer1.Visible := false;
 // показываем графическое поле текущей записи таблицы
 Image1.Picture.Assign(DBGrid1.DataSource.DataSet.FieldByName('BMP'));
Теперь покажу, как можно передвигать мышью визуальные компоненты в Run-Time. Для Panel1 установим DragMode = dmAutomatic, в OnDragOver формы пишем: 
 var
 Ct: TControl;
 begin
 // для упрощения проверяем перекрытие с другими контролами только правого нижнего угла
 Ct := ControlAtPos(Point(X + Panel1.Width, Y + Panel1.Height), True, True);
 Accept := (Source = Panel1) and ((Ct = nil) or (Ct = Panel1));
и в OnDragDrop формы очень просто 
 Panel1.Left := X;
 Panel1.Top := Y;
Другой метод перетаскивания можно встретить в каждом FAQ по Delphi: 
procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
const
 SC_DragMove = $F012;
begin
 ReleaseCapture;
 Panel2.Perform(WM_SysCommand, SC_DragMove, 0);
end;
И в завершение реализация популярной задачи перетаскивания значков файлов на форму из Проводника. Для этого следует описать обработчик сообщения WM_DROPFILES 
 private
 procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
В OnCreate формы разрешить прием файлов 
 DragAcceptFiles(Handle, true);
и в OnDestroy отключить его 
 DragAcceptFiles(Handle, False);
Процедура обработки приема файлов может выглядеть так: 
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
const
 maxlen = 254;
var
 h: THandle;
 //i, num: integer;
 pchr: array[0..maxlen] of char;
 fname: string;
begin
 h := Msg.Drop;
 // дана реализация для одного файла, а 
 // если предполагается принимать группу файлов, то можно добавить:
 // num := DragQueryFile(h, Dword(-1), nil, 0);
 // for i := 0 to num-1 do
 // begin
 // DragQueryFile(h,i,pchr,maxlen);
 // ...обработка каждого
 // end;
 DragQueryFile(h, 0, pchr, maxlen);
 fname := string(pchr);
 if LowerCase(ExtractFileExt(fname)) = '.bmp' then
 begin
 Image1.Visible := True;
 OleContainer1.Visible := False;
 Image1.Picture.LoadFromFile(fname);
 Panel3.Height := 300;
 end
 else if LowerCase(ExtractFileExt(fname)) = '.doc' then
 begin
 Image1.Visible := False;
 OleContainer1.Visible := True;
 OleContainer1.CreateObjectFromFile(fname, False);
 Panel3.Height := 300;
 end
 else if LowerCase(ExtractFileExt(fname)) = '.htm' then
 ShellExecute(0, nil, pchr, nil, nil, 0)
 else if LowerCase(ExtractFileExt(fname)) = '.txt' then
 Memo2.Lines.LoadFromFile(fname)
 else
 Memo2.Lines.Add(fname);
 DragFinish(h);
end;
При перетаскивании на форму файла с расширением Bmp он отображается в Image1, находящемся на Panel3, Doc загружается в OleContainer, для Htm запускается Internet Explorer или другой браузер по умолчанию, Txt отображается в Memo2, а для остальных файлов в Memo2 будет просто показано имя. 
Полагаю, на основе содержащихся в статье приемов будет нетрудно организовать перетаскивание и для других, не описанных здесь, визуальных компонентов. 
В заключение хочу выразить благодарность Игорю Шевченко и Максиму Власову за ценные советы при подготовке примеров... Автор статьи: Борис Новгородов, Новосибирск, 2002 
Author: Борис Новгородов
Source: Взято с сайта www.emanual.ru
ID: 00365
Category:VCL
Category:DragAndDrop
Category:Статьи
Category:Учебники