Валентин Озеров - Советы по Delphi. Версия 1.0.6

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 eView.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.

Var

MyButton: TButton;

MyButton:= TButton.Create(MyForm); // MyForm теперь "обладает" MyButton

with MyButton do BEGIN