Форум: "Основная";
Текущий архив: 2005.11.20;
Скачать: [xml.tar.bz2];

Вниз

Усовершенствование drag&drop   Найти похожие ветки 

← →
AngelOfDeath   (2005-10-26 10:35) [0]

Здравствуйте, уважаемые мастера! Я нашёл код для перетаскивания элементов в ListBox"е как в Winamp"е, для количества итемов > 1, поэтому код не мой. Но если взять достаточно большое количество, то начинаются зверские тормоза. Как от этого можно избавиться, т.е. повысить быстродействие (drag&drop в WinAmp"е, например)? Вот код:

var
ArrSelected: array of integer;//массив номеров выделенных строк
MoveableItemIndex:integer;  //номер элемента в массиве  ArrSelected
          //тот элемен за который мы перетаскиваем

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var APoint: TPoint;
index,i:integer;
begin
if Button=mbRight then
begin
 //выделенный номера помещаются в ArrSelected
  setlength(ArrSelected,0);
  for i:=0 to ListBox1.Items.Count-1 do
  if ListBox1.Selected[i] then
    begin
      setlength(ArrSelected,Length(ArrSelected)+1);
      ArrSelected[Length(ArrSelected)-1]:=i;
   end;
//тот элемент на котором нажали помещается в MoveableItemIndex
  MoveableItemIndex:=-1;
  APoint.X := X;
  APoint.Y := Y;
  index:= ListBox1.ItemAtPos(APoint, True);
  if (index<>-1)and(Length(ArrSelected)>0) then
   begin
     for i:=0 to Length(ArrSelected)-1 do
      if  ArrSelected[i]=index then  MoveableItemIndex:=i;
   end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Setlength(ArrSelected,0);
end;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var APoint: TPoint;
   index, offset,i,j:integer;
   pr:boolean;
begin
 if  (ssRight in Shift) and (MoveableItemIndex>-1) then
  begin
    //вычисляем новую позицию текущей строки MoveableItemIndex
    //и вычисляем индекс верхней выделеной строки, если она при передвижении
    //не выходит за границы списка, перемещаем все выделение
     APoint.X := X;
     APoint.Y := Y;
     index:= ListBox1.ItemAtPos(APoint, True);
     if (index>-1) and (index<>ArrSelected[MoveableItemIndex]) then
       begin
         //вычисляем смещение  MoveableItemIndex
         offset:=index-ArrSelected[MoveableItemIndex];
         //вычислим расстояние от первого выделенного элемента до начала списка
         if (ArrSelected[0]+offset>-1) and
            (ArrSelected[Length(ArrSelected)-1]+offset<ListBox1.Items.count)
          then
            begin
//само пережвижение по списку
            if offset>0 then
             for i:=Length(ArrSelected)-1 downto 0  do
              begin
                ListBox1.Items.Move(ArrSelected[i],ArrSelected[i]+offset);
                ArrSelected[i]:=ArrSelected[i]+offset;
              end
             else
                for i:=0 to Length(ArrSelected)-1  do
              begin
                ListBox1.Items.Move(ArrSelected[i],ArrSelected[i]+offset);
                ArrSelected[i]:=ArrSelected[i]+offset;
              end;

//помечаем выделением только те что в ArrSelected
             for i:=0 to ListBox1.Items.count-1 do
               begin
                pr:=false;
                for j:=0 to Length(ArrSelected)-1 do
                 if  i=ArrSelected[j] then pr:=true;
                ListBox1.selected[i]:=pr;
               end;
            end;
       end;
  end;
end;


Кстати, кто-нибудь знает, как устранить мерцание?

---

← →
clickmaker ©   (2005-10-26 11:13) [1]

> Кстати, кто-нибудь знает, как устранить мерцание?

LB.Items.BeginUpdate / EndUpdate

---

← →
AngelOfDeath   (2005-10-26 23:25) [2]

BeginUpdate / EndUpdate конечно хорошо. Но есть ли какие-нибудь предложения по оптимизации кода, т.к. это основной вопрос?

---

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

Форум: "Основная";
Текущий архив: 2005.11.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.146 c