Изменение позиций элементов ListBox с помощью Drag and Drop 3
Если вы хотите принимать перетаскиваемый объект, только если он представляет
собой собственный элемент, то в обработчике 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;
|
|
