Попробуйте для начала это:
unit Draglb; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls; typeTDragListBox = 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;beginRegisterComponents('Custom', [TDragListBox]);end; constructor TDragListBox.Create(AOwner: TComponent);beginInherited Create(AOwner);DragMode := dmAutomatic;OnDragDrop := DragDrop;OnDragOver := DragOver;end; procedure TDragListBox.DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);beginAccept := Source = Self;end; procedure TDragListBox.DragDrop(Sender, Source: TObject; X, Y: Integer);varValue: Integer;beginif Sender = Self thenbeginValue:=Self.ItemAtPos(Point(x,y), True); if Value = -1 thenbeginSelf.Items.Add(Self.Items[Self.ItemIndex]);Self.Items.Delete( Self.ItemIndex);end elsebeginSelf.Items.Insert(Value {+ 1}, Self.Items[Self.ItemIndex]);Self.Items.Delete( Self.ItemIndex);end;end;end; end. |
Чтобы заставить элемент перемещаться в позицию каждого элемента, вам необходимо сопоставлять область текущего элемента с текущим положения курсора мыши. Для организации автоматического скроллирования также необходимо вычислять текущие координаты курсора.
Nick Hodges
Monterey, CA [000575]
|
...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 THENWITH Sender AS TListBox DOIF Y>Height-ItemHeight THENBEGINGoingUp := False;Timer1.Enabled := True;ENDELSE IF Y>ItemHeight THENBEGINGoingUp := True;Timer1.Enabled := True;ENDELSE Timer1.Enabled := False;end; procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);VAR NuPos: Integer; begin WITH Sender AS TListBox DOBEGINNuPos := 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 DOIF GoingUp THENIF TopIndex>0 THEN TopIndex := TopIndex-1ELSE Timer1.Enabled := FalseELSEIF TopIndex<Items.Count-1 THEN TopIndex := TopIndex+1ELSE Timer1.Enabled := False;end; procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);begin Timer1.Enabled := False;end; |
[000649]
procedure TPickParty.PickListBMouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer); beginif Button = mbLeft thenwith Sender as TListBox dobeginDraggedPM:= ItemAtPos(Point(X,Y), True);if DraggedPM >l;= 0 then BeginDrag(False);end;end; procedure TPickParty.PickListBDragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean); beginif Source = PickListB then Accept:= True;end; procedure TPickParty.PickListBDragDrop(Sender, Source: TObject; X,Y: Integer);var NewIndex: integer;beginNewIndex:= PickListB.ItemAtPos(Point(X,Y), False);if NewIndex > PickListB.Items.Count-1 thenNewIndex:= PickListB.Items.Count-1;PickListB.Items.Move(DraggedPM, NewIndex);PickListB.ItemIndex:= NewIndex;end; |
- Peter Donnelly [000756]
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); begin with (Sender as TListBox) doItems.Move(ItemIndex,ItemAtPos(Point(x,y),True));end; procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := (Sender=Source);end; |
Не забудьте в ListBox присвоить свойству DragMode значение dmAutomatic.
[000150]