[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
Haakon Eines <haakon.eines@finale.no>
Here's a little TreeView-component that might be a little bit faster
than the default TTreeView from Borland. You also have the ability
to set the items text to bold (It's implemented as methods of the
treeview, but should have been a TTreeNode's property. Since
I can't release VCL source code - methods it is).
Some timings:
TTreeView:
128 sec. to load 1000 items (no sorting)*
270 sec. to save 1000 items (4.5 minutes!!!)
THETreeView:
1.5 sec. to load 1000 items - about 850% faster!!! (2.3 seconds
with sorting = stText)*
0.7 sec. to save 1000 items - about 3850% faster!!!
NOTES:
All timings performed on a slow 486SX 33 MhZ, 20 Mb RAM.
If the treeview is empty, loading takes 1.5 seconds, else add 1.5 seconds to clear 1000 items (a total loading time of 3 seconds). This is also the case for the TTreeView component (a total of 129.5 seconds). The process of clearing the items, is a call to SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).
Have fun playing with the component.
--------------------------------------------------------------------------------
unit HETreeView;
{$R-}
// Made by: Håkon Eines
// EMail: haakon.eines@finale.no
// Date: 21.01.1997
// Description: A Speedy TreeView?
(*
TTREEVIEW:
128 sec. to load 1000 items (no sorting)*
270 sec. to save 1000 items (4.5 minutes!!!)
THETREEVIEW:
1.5 sec. to load 1000 items - about 850% faster!!! (2.3 seconds with sorting = stText)*
0.7 sec. to save 1000 items - about 3850% faster!!!
NOTES:
- All timings performed on a slow 486SX 33 MhZ, 20 Mb RAM.
- * If the treeview is empty, loading takes 1.5 seconds,
else add 1.5 seconds to clear 1000 items (a total loading time of 3 seconds).
This is also the case for the TTreeView component (a total of 129.5 seconds).
The process of clearing the items, is a call to
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' should have been a property of TTreeNode, but...
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
//Delete all items - could have used Items.Clear (almost as fast)
SendMessage(handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
AOldLevel := 0;
AParentNode := nil;
//Switch sorting off
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('Invalid TreeNode Level');
end
else begin
for i := AOldLevel downto ALevel do
begin
AParentNode := AParentNode.Parent;
if (AParentNode = nil) and (i - ALevel > 0) then
raise Exception.Create('Invalid TreeNode Level');
end;
end;
AParentNode := Items.AddChild(AParentNode, ANewStr);
AOldLevel := ALevel;
end;
finally
//Switch sorting back to whatever it was...
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;
//Component Registration
procedure Register;
begin
RegisterComponents('Win95', [THETreeView]);
end;
end.
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]