| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

drag&drop в TListBox [D6, Win95/98, WinME, NT4, Win2k, WinXP]

Найти ©   (2005-08-17 11:09:00) 

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

---

НАйти   (2005-08-28 07:06:00) [1]

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;

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

---

КаПиБаРа   (2005-08-18 12:26:00) [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
   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;

---

Antonn   (2005-08-18 11:58:00) [3]

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

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

---

KilkennyCat   (2005-08-18 09:56:00) [4]

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

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;

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

---

КаПиБаРа   (2005-08-18 08:28:00) [5]

Что бы меньше мерцало
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;

---

Antonn   (2005-08-18 05:52:00) [6]

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

---

Найти   (2005-08-18 04:35:00) [7]

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

---

з. танька   (2005-08-17 14:41:00) [8]

но и это ещё не всё! в [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-17 14:20:00) [9]

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

---

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

установи 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;

---

Leonid Troyanovsky   (2005-08-17 11:43:00) [11]

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

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



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

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

--
Regards, LVT.

---

Наверх