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