Если вы хотите принимать перетаскиваемый объект, только если он представляет собой собственный элемент, то в обработчике 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]