Текущий архив: 2005.09.18;
Скачать: CL | DM;

Вниз

drag&drop в TListBox   Найти похожие ветки 

← →
Найти   (2005-08-17 11:09) [0]

Здравствуйте! Подскажите, пожалуйста, как с помощью OnMouseDown и OnMouseMove можно менять положение итемов, как, например, в WinAmp или в Foobar?

---

← →
Leonid Troyanovsky ©   (2005-08-17 11:43) [1]

> Найти   (17.08.05 11:09)  

> и OnMouseMove можно менять положение итемов, как, например,



Если OnMouse* необязательно, то, например

http://groups-beta.google.com/group/fido7.ru.delphi.chainik/msg/fb2c88d3e1a23e66

--
Regards, LVT.

---

← →
злобная танька   (2005-08-17 14:16) [2]

установи DragMode у ListBox1: dmAutomatic
.таскается прямо как в винампе можно ещё DragCursor поменять на стрелочку чтоб уж совсем один в один. только вот что плохо листбокс помигивает слегка при таскании итемов.. некрасиво :(

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
var
 P: TPoint;
 i: Integer;
begin
 if Source = ListBox1 then
 begin
   Accept := true;
   P := Point(X, Y);

   with ListBox1 do
   begin
     i := ItemAtPos(P, True);
     if i < 0 then
       Items.Move(ItemIndex, Items.Count - 1)
     else
       Items.Exchange(ItemIndex, i);
   end;

 end;
end;

---

← →
з. танька   (2005-08-17 14:20) [3]

строчку "Accept := true;" можно выкинуть. не нужна она тама..

---

← →
з. танька   (2005-08-17 14:41) [4]

но и это ещё не всё! в [2] обнаружены довольно злые баги. так что лучше вот так:

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
var
 P            : TPoint;
 i,j          : Integer;
begin
 if Source = ListBox1 then
 begin
   if ListBox1.ItemIndex = -1 then
     exit;

   P := Point(X, Y);

   with ListBox1 do
   begin
     i := ItemAtPos(P, False);
     if (i > Items.Count - 1) then
       Items.Move(ItemIndex, Items.Count - 1)
     else
       if i > -1 then
         Items.Exchange(ItemIndex, i);
   end;

 end;
end;

---

← →
Найти   (2005-08-18 04:35) [5]

Спасибо, работает, несмотря на мерцание, но ещё интересно, что эффективнее было бы применить: OnMouse* или DragDrop, DragOver и т.д., т.е. набор для работы с Drag&Drop?

---

← →
Antonn ©   (2005-08-18 05:52) [6]

и при OnMouse тоже мерцает.
можешь глянуть:
http://an-files.narod.ru/_works/5016.html

---

← →
КаПиБаРа ©   (2005-08-18 08:28) [7]

Что бы меньше мерцало
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
P            : TPoint;
i,j          : Integer;
begin
if Source = ListBox1 then
begin
  if ListBox1.ItemIndex = -1 then
    exit;

  P := Point(X, Y);

  with ListBox1 do
  begin
    i := ItemAtPos(P, False);
    if (i > Items.Count - 1) and (ItemIndex <> Items.Count - 1) then
      Items.Move(ItemIndex, Items.Count - 1)
    else
      if (i > -1) and (ItemIndex <> i) then
        Items.Exchange(ItemIndex, i);
  end;

end;
end;

---

← →
KilkennyCat ©   (2005-08-18 09:56) [8]

а я по-другому делаю...

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
 with (Source as TListBox) do
   if Sender = Source then Items.Move(ItemIndex,ItemAtPos(Point(x,y),true));
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
 Accept := (Source as TListBox).ItemIndex <> - 1;
end;

мерцаний не видел.

---

← →
Antonn ©   (2005-08-18 11:58) [9]

KilkennyCat ©   (18.08.05 9:56) [8]
другая функциональность, нужно "реал-тайм":)

КаПиБаРа ©   (18.08.05 8:28) [7]
при перемещении ниже кол-ва итемов вылазит АВ

---

← →
КаПиБаРа ©   (2005-08-18 12:26) [10]

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
var
P            : TPoint;
i,j          : Integer;
begin
if Source = ListBox1 then
begin
 if ListBox1.ItemIndex = -1 then
   exit;

 P := Point(X, Y);

 with ListBox1 do
 begin
   i := ItemAtPos(P, False);
   if (i > Items.Count - 1) then
   begin
     if (ItemIndex <> Items.Count - 1) then
     Items.Move(ItemIndex, Items.Count - 1)
   end
   else
     if (i > -1) and (ItemIndex <> i) then
       Items.Exchange(ItemIndex, i);
 end;
end;
end;

---

← →
НАйти   (2005-08-28 07:06) [11]

Antonn ©
А что такое АВ?

КаПиБаРа ©
Уменьшение мерцания происходит за счёт дополнительных условий?
--------------------------
На основе полученного, за что большое спасибо, решил попробовать перетащить несколько итемов. Схема действия та же самая остаётся? Извиняюсь за такой вопрос, просто с drag$drop впервые столкнулся. Вот, у меня есть код ещё, не "real-time", но перетаскиваются несколько итемов:

procedure TDualListDlg.DstListDragDrop(Sender, Source: TObject; X,Y: Integer);
var droppedOnIndex: integer;
   anItem:        integer;
   numberOfItems: integer;
begin
if (Sender is TListbox) and (Source is TListBox) then
begin
 droppedOnIndex := TListBox(Sender).ItemAtPos(Point(X,Y),false);
 numberOfItems := TListBox(Source).SelCount;
 anItem := 0;
 while numberOfItems > 0 do
  begin
   if TListBox(Source).Selected[anItem] = true then
    begin
     TListBox(Sender).Items.Insert(droppedOnIndex,TListBox(Source).Items[anItem]);
     TListBox(Source).Items.Delete(anItem);
     TListBox(Source).Update;
     TListBox(Sender).Update;
     numberOfItems := numberOfItems - 1;
    end
    else
     anItem := anItem + 1;
  end;
end;
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := true;
end;

Однако у него есть неприятная проблема. Я попробовал совместить коды, ничего не получилось. Их совместить вообще возможно или надо другое думать?

---

Страницы: 1 вся ветка

Текущий архив: 2005.09.18;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.028 c