Советы по Delphi
         

Ускорение работы TreeView


Представляем вашему вниманию немного переработанный компонент TreeView, работающий быстрее своего собрата из стандартной поставки Delphi. Кроме того, была добавлена возможность вывода текста узлов и пунктов в жирном начертании (были использованы методы TreeView, хотя, по идее, необходимы были свойства TreeNode. Мне показалось, что это будет удобнее).

Для сравнения:TreeView:128 сек. для загрузки 1000 элементов (без сортировки)*270 сек. для сохранения 1000 элементов (4.5 минуты!!!)
HETreeView:1.5 сек. для загрузки 1000 элементов - ускорение около 850%!!! (2.3 секунды без сортировки = stText)*0.7 сек. для сохранения 1000 элементов - ускорение около 3850%!!!
Примечание:

  • Все операции выполнялись на медленной машине 486SX 33 Mгц, 20 Mб RAM.
  • Если TreeView пуст, загрузка происходит за 1.5 секунды, плюс 1.5 секунды на стирание 1000 элементов (общее время загрузки составило 3 секунды). В этих условиях стандартный компонент TTreeView показал общее время 129.5 секунд. Очистка компонента осуществлялась вызовом функции SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).
Проведите несколько приятных минут, развлекаясь с компонентом.

unit HETreeView;
{$R-}

// Описание: Реактивный TreeView
(*
TREEVIEW:128 сек. для загрузки 1000 элементов (без сортировки)*270 сек. для сохранения 1000 элементов (4.5 минуты!!!)
HETREEVIEW:1.5 сек. для загрузки 1000 элементов - ускорение около 850%!!! (2.3 секунды без сортировки = stText)*0.7 сек. для сохранения 1000 элементов - ускорение около 3850%!!!
NOTES:- Все операции выполнялись на медленной машине 486SX 33 Mгц, 20 Mб RAM.
- * Если TTreeView пуст, загрузка происходит за 1.5 секунды,плюс 1.5 секунды на стирание 1000 элементов (общее время загрузки составило 3 секунды).В этих условиях стандартный компонент TreeView показал общее время 129.5 секунд.Очистка компонента осуществлялась вызовом функцииSendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).*)

interface

uses
SysUtils, Windows, Messages, Classes, Graphics,Controls, Forms, Dialogs, ComCtrls, CommCtrl;
type
THETreeView = class(TTreeView)privateFSortType: TSortType;procedure SetSortType(Value: TSortType);protectedfunction GetItemText(ANode: TTreeNode): string;publicconstructor Create(AOwner: TComponent); override;function AlphaSort: Boolean;function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;procedure LoadFromFile(const AFileName: string);procedure SaveToFile(const AFileName: string);procedure GetItemList(AList: TStrings);procedure SetItemList(AList: TStrings);//Жирное начертание шрифта 'Bold' должно быть свойством TTreeNode, но...function IsItemBold(ANode: TTreeNode): Boolean;procedure SetItemBold(ANode: TTreeNode; Value: Boolean);publishedproperty SortType: TSortType read FSortType write SetSortType default stNone;end;
procedure Register;
implementation

function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
{with Node1 doif Assigned(TreeView.OnCompare) thenTreeView.OnCompare(Node1.TreeView, Node1, Node2, lParam, Result)else}Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));end;

constructor THETreeView.Create(AOwner: TComponent);begin
inherited Create(AOwner);FSortType := stNone;end;

procedure THETreeView.SetItemBold(ANode: TTreeNode; Value: Boolean);
var
Item: TTVItem;Template: Integer;begin
if ANode = nil then Exit;
if Value then Template := -1else Template := 0;with Item dobeginmask := TVIF_STATE;hItem := ANode.ItemId;stateMask := TVIS_BOLD;state := stateMask and Template;end;TreeView_SetItem(Handle, Item);end;

function THETreeView.IsItemBold(ANode: TTreeNode): Boolean;
var
Item: TTVItem;begin
Result := False;if ANode = nil then Exit;
with Item dobeginmask := TVIF_STATE;hItem := ANode.ItemId;if TreeView_GetItem(Handle, Item) thenResult := (state and TVIS_BOLD) <> 0;end;end;

procedure THETreeView.SetSortType(Value: TSortType);
begin
if SortType <> Value thenbeginFSortType := Value;if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or(SortType in [stText, stBoth]) thenAlphaSort;end;end;

procedure THETreeView.LoadFromFile(const AFileName: string);
var
AList: TStringList;begin
AList := TStringList.Create;Items.BeginUpdate;tryAList.LoadFromFile(AFileName);SetItemList(AList);finallyItems.EndUpdate;AList.Free;end;end;

procedure THETreeView.SaveToFile(const AFileName: string);
var
AList: TStringList;begin
AList := TStringList.Create;tryGetItemList(AList);AList.SaveToFile(AFileName);finallyAList.Free;end;end;

procedure THETreeView.SetItemList(AList: TStrings);
var
ALevel, AOldLevel, i, Cnt: Integer;S: string;ANewStr: string;AParentNode: TTreeNode;TmpSort: TSortType;
function GetBufStart(Buffer: PChar; var ALevel: Integer): PChar;beginALevel := 0;while Buffer^ in [' ', #9] dobeginInc(Buffer);Inc(ALevel);end;Result := Buffer;end;
begin
//Удаление всех элементов - в обычной ситуации подошло бы Items.Clear, но уж очень медленноSendMessage(handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));AOldLevel := 0;AParentNode := nil;
//Снятие флага сортировкиTmpSort := SortType;SortType := stNone;tryfor Cnt := 0 to AList.Count-1 dobeginS := AList[Cnt];if (Length(S) = 1) and (S[1] = Chr($1A)) then Break;
ANewStr := GetBufStart(PChar(S), ALevel);if (ALevel > AOldLevel) or (AParentNode = nil) thenbeginif ALevel - AOldLevel > 1 then raise Exception.Create('Неверный уровень TreeNode');endelse beginfor i := AOldLevel downto ALevel dobeginAParentNode := AParentNode.Parent;if (AParentNode = nil) and (i - ALevel > 0) thenraise Exception.Create('Неверный уровень TreeNode');end;end;AParentNode := Items.AddChild(AParentNode, ANewStr);AOldLevel := ALevel;end;finally//Возвращаем исходный флаг сортировки...SortType := TmpSort;end;end;

procedure THETreeView.GetItemList(AList: TStrings);
var
i, Cnt: integer;ANode: TTreeNode;begin
AList.Clear;Cnt := Items.Count -1;ANode := Items.GetFirstNode;for i := 0 to Cnt dobeginAList.Add(GetItemText(ANode));ANode := ANode.GetNext;end;end;

function THETreeView.GetItemText(ANode: TTreeNode): string;
begin
Result := StringOfChar(' ', ANode.Level) + ANode.Text;end;

function THETreeView.AlphaSort: Boolean;
var
I: Integer;begin
if HandleAllocated thenbeginResult := CustomSort(nil, 0);endelse Result := False;end;

function THETreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
var
SortCB: TTVSortCB;I: Integer;Node: TTreeNode;begin
Result := False;if HandleAllocated thenbeginwith SortCB dobeginif not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSortelse lpfnCompare := SortProc;hParent := TVI_ROOT;lParam := Data;Result := TreeView_SortChildrenCB(Handle, SortCB, 0);end;
if Items.Count > 0 thenbeginNode := Items.GetFirstNode;while Node <> nil dobeginif Node.HasChildren then Node.CustomSort(SortProc, Data);Node := Node.GetNext;end;end;end;end;

//Регистрация компонента
procedure Register;
begin
RegisterComponents('Win95', [THETreeView]);end;

end.
[000054]



Содержание раздела