Форум: "Основная";
Текущий архив: 2005.09.18;
Скачать: [xml.tar.bz2];
Вниз
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;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.011 c
