Советы по 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, tree2vw;
type
THETreeView = class(TTreeView) private FSortType: TSortType; procedure SetSortType(Value: TSortType); protected function GetItemText(ANode: TTreeNode): string; public constructor 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); published property SortType: TSortType read FSortType write SetSortType default stNone; end;
procedure Register;
implementation

function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
{with Node1 do if Assigned(TreeView.OnCompare) then TreeView.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 := -1 else Template := 0; with Item do begin mask := 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 do begin mask := TVIF_STATE; hItem := ANode.ItemId; if TreeView_GetItem(Handle, Item) then Result := (state and TVIS_BOLD) <> 0; end; end;

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

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

procedure THETreeView.SaveToFile(const AFileName: string);
var
AList: TStringList; begin
AList := TStringList.Create; try GetItemList(AList); AList.SaveToFile(AFileName); finally AList.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; begin ALevel := 0; while Buffer^ in [' ', #9] do begin Inc(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; try for Cnt := 0 to AList.Count-1 do begin S := AList[Cnt]; if (Length(S) = 1) and (S[1] = Chr($1A)) then Break;
ANewStr := GetBufStart(PChar(S), ALevel); if (ALevel > AOldLevel) or (AParentNode = nil) then begin if ALevel - AOldLevel > 1 then raise Exception.Create('Неверный уровень TreeNode'); end else begin for i := AOldLevel downto ALevel do begin AParentNode := AParentNode.Parent; if (AParentNode = nil) and (i - ALevel > 0) then raise 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 do begin AList.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 then begin Result := CustomSort(nil, 0); end else Result := False; end;

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

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

end.
[000054]



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