Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.08.28;
Скачать: [xml.tar.bz2];

Вниз

преобразование списка каталогов в древообразный вид   Найти похожие ветки 

 
Андрей Молчанов   (2005-08-08 18:11) [0]

Здравствуйте!

Необходимо выполнять сабж (для отображения содержимого zip). Колличество файлов ОЧЕНЬ большое. Раньше использовал свой алгоритм, но теперь он перестал устраивать. Как Вы думаете, что можно сделать в плане быстродействия?

Предварительная загрузка путей:

var
 i: integer;
 s: string;
 Structure: array of array of string;
 Node: TTreeNode;
 AddedList: TStringList;
begin
SetLength(Structure, 0);
SetLength(Structure, VCLUnZip.Count);
for i := 0 to VCLUnZip.Count-1 do begin
 s := IncludeTrailingPathDelimiter(VCLUnZip.Pathname[i]);
 while Pos("\", s) > 0 do begin
   if s = "\" then break;
   SetLength(Structure[i], Length(Structure[i]) + 1);
   Structure[i, Length(Structure[i]) - 1] := Copy(s, 0, Pos("\", s) - 1);
   Delete(s, 1, Pos("\", s));
 end;
 SetLength(Structure[i], Length(Structure[i]) + 1);
 Structure[i, Length(Structure[i]) - 1] := VCLUnZip.Filename[i];
end;

//Добавление первого элемента в дерево
AddedList := TStringList.Create;
AddedList.Add("");
CheckTree.Items.BeginUpdate;

CheckTree.Items[0].DeleteChildren;
CheckTree.Items[0].Text := ExtractFileName(edtZipArchive.Text);

for i := 0 to Length(Structure)-1 do begin
 if AddedList.IndexOf(Structure[i, 0]) = -1 then begin
   AddedList.Add(Structure[i, 0]);
   Node := CheckTree.Items.AddChild(CheckTree.Items[0], Structure[i, 0]);
   if Length(Structure[i]) > Node.Level then begin
     Node.ImageIndex := -1;
     Node.SelectedIndex := -1;
     Node.HasChildren := True;
   end else
     SetIconsByExt(ExtractFileExt(Node.Text), Node);
 end;
end;

CheckTree.AlphaSort(True);
CheckTree.Items[0].Expanded := True;
SendMessage(CheckTree.Handle, WM_VSCROLL, SB_TOP, 0);
CheckTree.Items.EndUpdate;
end;


Но все вышеприведенное вызывается только один раз. А вот эта процедура реально тормозит:

procedure TfrmRestoreWizard.CheckTreeExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
 function StructureTree(X, Y: integer): string;
 var
   i: integer;
 begin
   Result := "";
   for i := Y downto 0 do
     Result := Structure[X, i] + "\" + Result;
 end;
var
 s: string;
 i: integer;
 Child: TTreeNode;
 AddedList: TStringList;
begin
if (Node.getFirstChild = nil) and (Node.Level > 0) then begin
 Screen.Cursor := crHourGlass;
 CheckTree.Items.BeginUpdate;
 s := IncludeTrailingPathDelimiter(MyPathFromNode(Node));
 AddedList := TStringList.Create;
 AddedList.Add("");
 try
   for i := 0 to Length(Structure)-1 do begin
     if (Length(Structure[i]) > Node.Level) and (s = StructureTree(i, Node.Level-1)) then begin
       if AddedList.IndexOf(Structure[i, Node.Level]) = -1 then begin
         AddedList.Add(Structure[i, Node.Level]);
         Child := CheckTree.Items.AddChild(Node, Structure[i, Node.Level]);
         Child.StateIndex := Node.StateIndex;
         if Length(Structure[i]) > Node.Level+1 then begin
           Child.ImageIndex := -1;
           Child.SelectedIndex := -1;
           Child.HasChildren := True;
         end else
           SetIconsByExt(ExtractFileExt(Child.Text), Child);
       end;
     end;
   end;
 finally
   AddedList.Free;
   Node.AlphaSort;
   CheckTree.Items.EndUpdate;
   Screen.Cursor := crDefault;
 end;
end;
end;


Пожалуйста, подскажите. Спасибо.


 
Андрей Молчанов   (2005-08-08 19:14) [1]

Вот еще: насколько я понял, основные тормоза вот здесь:
  for i := 0 to Length(Structure)-1 do begin
    if (Length(Structure[i]) > Node.Level) and (s = StructureTree(i, Node.Level-1)) then begin
      if AddedList.IndexOf(Structure[i, Node.Level]) = -1 then begin
        AddedList.Add(Structure[i, Node.Level]);
        Child := CheckTree.Items.AddChild(Node, Structure[i, Node.Level]);
        Child.StateIndex := Node.StateIndex;
        if Length(Structure[i]) > Node.Level+1 then begin
          Child.ImageIndex := -1;
          Child.SelectedIndex := -1;
          Child.HasChildren := True;
        end else
          SetIconsByExt(ExtractFileExt(Child.Text), Child);
      end;
    end;
  end;


 
Суслик ©   (2005-08-08 20:03) [2]


> SetLength(Structure[i], Length(Structure[i]) + 1);

не делай так.

Выделяй сразу

SetLength(Structure[i], ...count...)

дальше заполняй.

Когда дин. массив заполняешь по одному элементу - это сильно тормозит.


 
Суслик ©   (2005-08-08 20:04) [3]

Если нет возможности сразу определить длину массива (честно говоря лень код разбирать) то пользуйся TSTringList и добавляй по одному элементу. Там проведена оптимизация в целях ускорения добавления по одному элементу.


 
Андрей Молчанов   (2005-08-08 20:17) [4]

Спасибо исправлю, но... тормозит вот в этом месте, при проверке условий в цикле, т.к. Length(Structure)-1 достаточно большой (несколько тысяч).


 for i := 0 to Length(Structure)-1 do begin
   if (Length(Structure[i]) > Node.Level) and (s = StructureTree(i, Node.Level-1)) then begin
     if AddedList.IndexOf(Structure[i, Node.Level]) = -1 then begin         AddedList.Add(Structure[i, Node.Level]);
       ...
     end;
   end;
 end;


 
Суслик ©   (2005-08-09 09:54) [5]

ты используешь TStringList?

Поставь у него флажок sorted.

Тогда


> AddedList.IndexOf(Structure[i, Node.Level]) = -1


это будет существенно быстрей работать.


 
WondeRu ©   (2005-08-09 09:57) [6]

Андрей Молчанов   (08.08.05 19:14) [1]
SetIconsByExt(ExtractFileExt(Child.Text), Child);

что это?
Если проставление иконок для узлов, то торррмозоа тебе гарантированы ;)


 
Андрей Молчанов   (2005-08-09 18:45) [7]

Все - вроде дооптимизировал до приемлимого уровня. Спасибо.



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

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

Наверх




Память: 0.47 MB
Время: 0.037 c
3-1121337642
Ирина
2005-07-14 14:40
2005.08.28
SetField, AppendRecord


1-1122699937
Navi
2005-07-30 09:05
2005.08.28
AutoCAD + Delphi - аргументы для SetXRecordData?


8-1113997439
Comrade
2005-04-20 15:43
2005.08.28
Просмотр Видио файла


14-1122965493
Игорь Шевченко
2005-08-02 10:51
2005.08.28
Наши программисты победили в Йокогаме


14-1122549507
Андрей Жук
2005-07-28 15:18
2005.08.28
Три вещи, без которых нельзя прожить (не моё)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский