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

Автор: Александр Малыгин
Специально для Королевства Delphi

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

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

Второй обработчик вызывается, когда пользователь отпускает кнопку мыши, и контрол Sender:TObject должен отработать прием переданной ему "посылки" Source:TObject, по координатам X,Y : integer.

Предлагаемый пример DualListFrame реализует операции drag'n'drop над двумя списками TListBox, организованными в один фрейм с органами управления. Прототипом послужил стандартный шаблон-форма "Dual list box" из репозитория Delphi и аналогичный компонент-диалог из библиотеки RxLib. Первый не снабжен функциями drag'n'drop, а второй хоть и умеет это, но все равно является отдельным диалогом, что не всегда удобно.

Данный пример благодаря технологии фреймов позволяет встроить двойной список "со всеми причиндалами" в любую форму проекта. Чтобы им воспользоваться, достаточно подключить модуль DualListFrame.pas к проекту. Для удобства при многократном использовании (в разных проектах) можно добавить его в репозиторий, скопировав предварительно в общую для шаблонов директорию (например, "Delphi5\ObjRepos"). В архиве вместе с кодом и ресурсом фрейма имеется пиктограмма для репозитория и вырезка из файла "Delphi5\Bin\delphi32.dro".

Ниже приведены фрагменты исходного текста, ключевые для реализации технологии "тащи и бросай".

procedure TfrDualList.ListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  DragIndex: integer;
begin
  // из другого листбокса принимаем всегда
  if Source <> Sender then
    Accept := true
      // а если это мы сами - надо проверить возможность изменения порядка
    // в списке и позицию сбрасывания
  else
    with (Sender as TListBox) do
    begin
      Accept := False;
      if not Sorted and ((SelCount = 1) or (not MultiSelect)) then
      begin
        DragIndex := ItemAtPos(Point(X, Y), True);
        if (DragIndex >= 0) and (DragIndex <> ItemIndex) then
          Accept := True; // попали внутрь видимого списка
      end;
    end;
  // установка изображения курсора
  if State = dsDragLeave then
    (Source as TListBox).DragCursor := crDrag;
  if (State = dsDragEnter) and ((Source as TListBox).SelCount > 1) then
    (Source as TListBox).DragCursor := crMultiDrag;
end;

procedure TfrDualList.ListDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Source <> Sender then // перемещаем элементы из другого листбокса
    MoveItems(TListBox(Source), TListBox(Sender))
  else
    BoxMoveSel(TListBox(Sender), // перемещаем элемент внутри списка
      TListBox(Sender).ItemAtPos(Point(X, Y), True));
end;