Советы по Delphi
Изменение позиций элементов ListBox с помощью drag&drop II
Я хотел бы изменить порядок следования элементов в неотсортированном списке ListBox методом drag&drop, т.е. просто перетаскивая их мышью на нужное место. Будет еще лучше, если при удержании кнопки мыши перетаскиваемый элемент визуально перемещал бы вверх или вниз сам список (для определения своего нового месторасположения) до тех пор, пока клавиша мыши не будет отпущена (как я понял, автоматическое скроллирование - В.О.).
Попробуйте для начала это:
|
unit Draglb;
interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TDragListBox = 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; begin RegisterComponents('Custom', [TDragListBox]); end; constructor TDragListBox.Create(AOwner: TComponent); begin Inherited Create(AOwner); DragMode := dmAutomatic; OnDragDrop := DragDrop; OnDragOver := DragOver; end; procedure TDragListBox.DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := Source = Self; end; procedure TDragListBox.DragDrop(Sender, Source: TObject; X, Y: Integer); var Value: Integer; begin if Sender = Self then begin Value:=Self.ItemAtPos(Point(x,y), True); if Value = -1 then begin Self.Items.Add(Self.Items[Self.ItemIndex]); Self.Items.Delete( Self.ItemIndex); end else begin Self.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 THEN WITH Sender AS TListBox DO IF Y>Height-ItemHeight THEN BEGIN GoingUp := False; Timer1.Enabled := True; END ELSE IF Y>ItemHeight THEN BEGIN GoingUp := True; Timer1.Enabled := True; END ELSE Timer1.Enabled := False; end; procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); VAR NuPos: Integer; begin WITH Sender AS TListBox DO BEGIN NuPos := 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 DO IF GoingUp THEN IF TopIndex>0 THEN TopIndex := TopIndex-1 ELSE Timer1.Enabled := False ELSE IF TopIndex<Items.Count-1 THEN TopIndex := TopIndex+1 ELSE 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);
begin if Button = mbLeft then with Sender as TListBox do begin DraggedPM:= 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); begin if Source = PickListB then Accept:= True; end; procedure TPickParty.PickListBDragDrop(Sender, Source: TObject; X,Y: Integer); var NewIndex: integer; begin NewIndex:= PickListB.ItemAtPos(Point(X,Y), False); if NewIndex > PickListB.Items.Count-1 then NewIndex:= 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) do Items.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]