[Vayrus]

Еще вариант

Код:

...

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;