Советы по Delphi
Изменение позиций элементов ListBox с помощью drag&drop II
Я хотел бы изменить порядок следования элементов в неотсортированном списке ListBox методом drag&drop, т.е. просто перетаскивая их мышью на нужное место. Будет еще лучше, если при удержании кнопки мыши перетаскиваемый элемент визуально перемещал бы вверх или вниз сам список (для определения своего нового месторасположения) до тех пор, пока клавиша мыши не будет отпущена (как я понял, автоматическое скроллирование - В.О.).
Попробуйте для начала это:
| unit Draglb; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls; typeTDragListBox = class(TListBox)private{ Private declarations }protected{ Protected declarations }public{ Public declarations }procedure DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);procedure DragDrop(Sender, Source: TObject; X, Y: Integer);constructor Create(AOwner: TComponent); override;{ Published declarations }end; procedure Register; implementation procedure Register;beginRegisterComponents('Custom', [TDragListBox]);end; constructor TDragListBox.Create(AOwner: TComponent);beginInherited Create(AOwner);DragMode := dmAutomatic;OnDragDrop := DragDrop;OnDragOver := DragOver;end; procedure TDragListBox.DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);beginAccept := Source = Self;end; procedure TDragListBox.DragDrop(Sender, Source: TObject; X, Y: Integer);varValue: Integer;beginif Sender = Self thenbeginValue:=Self.ItemAtPos(Point(x,y), True); if Value = -1 thenbeginSelf.Items.Add(Self.Items[Self.ItemIndex]);Self.Items.Delete( Self.ItemIndex);end elsebeginSelf.Items.Insert(Value {+ 1}, Self.Items[Self.ItemIndex]);Self.Items.Delete( Self.ItemIndex);end;end;end; end. |
Чтобы заставить элемент перемещаться в позицию каждого элемента, вам необходимо сопоставлять область текущего элемента с текущим положения курсора мыши. Для организации автоматического скроллирования также необходимо вычислять текущие координаты курсора.
Nick Hodges
Monterey, CA [000575]
Если вы хотите принимать перетаскиваемый объект, только если он представляет собой собственный элемент, то в обработчике OnDragOver вставьте строчку "Accept := Source=Sender;". Ниже приведен код, позволяющий сортировать элементы с помощью перетаскивания их мышкой внутри списка компонента. Вам также понадобится таймер для обеспечения функции автопрокручивания. Это означает, что при перетаскивании элемента в верхнюю часть списка, он при необходимости прокручивается вниз, дабы стали видны невидимые в верхней части списка элементы. Если вам не нужно такое поведение компонента, исключите из кода все строчки, имеющие отношение к таймеру, включая вторую строчку в обработчике события OnDragOver.
|
|
...private{ Private declarations }GoingUp : Boolean; procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);begin Accept := (Sender = Source) AND(TListBox(Sender).ItemAtPos(Point(X,Y),False) >= 0);{устанавливаем таймер для автопрокрутки}IF Accept THENWITH Sender AS TListBox DOIF Y>Height-ItemHeight THENBEGINGoingUp := False;Timer1.Enabled := True;ENDELSE IF Y>ItemHeight THENBEGINGoingUp := True;Timer1.Enabled := True;ENDELSE Timer1.Enabled := False;end; procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);VAR NuPos: Integer; begin WITH Sender AS TListBox DOBEGINNuPos := ItemAtPos(Point(X,Y),False);IF NuPos >= Items.Count THEN Dec(NuPos);Label1.Caption := Format('Перемещено из %d в %d',[ItemIndex, NuPos]);Items.Move(ItemIndex, NuPos);{выделяем перемещенный элемент}ItemIndex := NuPos;END;end; procedure TForm1.Timer1Timer(Sender: TObject); begin WITH ListBox1 DOIF GoingUp THENIF TopIndex>0 THEN TopIndex := TopIndex-1ELSE Timer1.Enabled := FalseELSEIF TopIndex<Items.Count-1 THEN TopIndex := TopIndex+1ELSE Timer1.Enabled := False;end; procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);begin Timer1.Enabled := False;end; |
[000649]
Вот еще одна вариация сабжа.
| procedure TPickParty.PickListBMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); beginif Button = mbLeft thenwith Sender as TListBox dobeginDraggedPM:= ItemAtPos(Point(X,Y), True);if DraggedPM >l;= 0 then BeginDrag(False);end;end; procedure TPickParty.PickListBDragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); beginif Source = PickListB then Accept:= True;end; procedure TPickParty.PickListBDragDrop(Sender, Source: TObject; X,Y: Integer);var NewIndex: integer;beginNewIndex:= PickListB.ItemAtPos(Point(X,Y), False);if NewIndex > PickListB.Items.Count-1 thenNewIndex:= PickListB.Items.Count-1;PickListB.Items.Move(DraggedPM, NewIndex);PickListB.ItemIndex:= NewIndex;end; |
- Peter Donnelly [000756]
Единственно интересный код:
| procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); begin with (Sender as TListBox) doItems.Move(ItemIndex,ItemAtPos(Point(x,y),True));end; procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := (Sender=Source);end; |
Не забудьте в ListBox присвоить свойству DragMode значение dmAutomatic.
[000150]
