Изменение позиций элементов ListBox с помощью drag&drop II
Я хотел бы изменить порядок следования элементов в неотсортированном списке ListBox методом drag&drop, т.е. просто перетаскивая их мышью на нужное место. Будет еще лучше, если при удержании кнопки мыши перетаскиваемый элемент визуально перемещал бы вверх или вниз сам список (для определения своего нового месторасположения) до тех пор, пока клавиша мыши не будет отпущена (как я понял, автоматическое скроллирование - В.О.).
Попробуйте для начала это:
|
unit Draglb;
interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TDragListBox = class(TListBox) private { Private declarations } protected { Protected declarations } public { Public declarations } procedure DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure DragDrop(Sender, Source: TObject; X, Y: Integer); constructor Create(AOwner: TComponent); override; { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Custom', [TDragListBox]); end; constructor TDragListBox.Create(AOwner: TComponent); begin Inherited Create(AOwner); DragMode := dmAutomatic; OnDragDrop := DragDrop; OnDragOver := DragOver; end; procedure TDragListBox.DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := Source = Self; end; procedure TDragListBox.DragDrop(Sender, Source: TObject; X, Y: Integer); var Value: Integer; begin if Sender = Self then begin Value:=Self.ItemAtPos(Point(x,y), True); if Value = -1 then begin Self.Items.Add(Self.Items[Self.ItemIndex]); Self.Items.Delete( Self.ItemIndex); end else begin Self.Items.Insert(Value {+ 1}, Self.Items[Self.ItemIndex]); Self.Items.Delete( Self.ItemIndex); end; end; end; end. |
Чтобы заставить элемент перемещаться в позицию каждого элемента, вам необходимо сопоставлять область текущего элемента с текущим положения курсора мыши. Для организации автоматического скроллирования также необходимо вычислять текущие координаты курсора.
Nick Hodges
Monterey, CA
[000575]
