Изменение позиций элементов ListBox с помощью Drag and Drop
Если вы хотите принимать перетаскиваемый объект, только если он представляет собой собственный элемент, то в обработчике OnDragOver вставьте строчку "Accept := Source=Sender;". Ниже приведен код, позволяющий сортировать элементы с помощью перетаскивания их мышкой внутри списка компонента. Вам также понадобится таймер для обеспечения функции автопрокручивания. Это означает, что при перетаскивании элемента в верхнюю часть списка, он при необходимости прокручивается вниз, дабы стали видны невидимые в верхней части списка элементы. Если вам не нужно такое поведение компонента, исключите из кода все строчки, имеющие отношение к таймеру, включая вторую строчку в обработчике события OnDragOver.
|
Code: |
|
... 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; |
https://delphiworld.narod.ru/
DelphiWorld 6.0
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!