LCL/ShellTreeView: Speed-up of populating a folder with many subfolders (example: c:\Windows\WinSxS)

git-svn-id: trunk@65454 -

lcl/comctrls.pp

@@ -2845,7 +2845,8 @@ type
     nsHasChildren,   // = Node.HasChildren
     nsDeleting,      // = Node.Deleting, set on Destroy
     nsVisible,       // = Node.Visible
-    nsBound          // bound to a tree, e.g. has Parent or is top lvl node
+    nsBound,          // bound to a tree, e.g. has Parent or is top lvl node
+    nsValidHasChildren// Node.HasChildren has been assigned
     );
   TNodeStates = set of TNodeState;
 
@@ -2919,6 +2920,8 @@ type
                                        var ATreeNode: TTreenode) of object;
   TTVCreateNodeClassEvent = procedure(Sender: TCustomTreeView;
                                       var NodeClass: TTreeNodeClass) of object;
+  TTVHasChildrenEvent = function(Sender: TCustomTreeView;
+                                 ANode: TTreeNode): Boolean of object;
 
   TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object;
 
@@ -2992,12 +2995,12 @@ type
     procedure ExpandItem(ExpandIt, Recurse: Boolean);
     function GetAbsoluteIndex: Integer;
     function GetDeleting: Boolean;
-    function GetHasChildren: Boolean;
     function GetCount: Integer;
     function GetCut: boolean;
     function GetDropTarget: Boolean;
     function GetExpanded: Boolean;
     function GetFocused: Boolean;
+    function GetHasChildren: Boolean;
     function GetHeight: integer;
     function GetIndex: Integer;
     function GetItems(AnIndex: Integer): TTreeNode;
@@ -3379,6 +3382,7 @@ type
     FOnExpanding: TTVExpandingEvent;
     FOnGetImageIndex: TTVExpandedEvent;
     FOnGetSelectedIndex: TTVExpandedEvent;
+    FOnHasChildren: TTVHasChildrenEvent;
     FOnNodeChanged: TTVNodeChangedEvent;
     FOnSelectionChanged: TNotifyEvent;
     FOptions: TTreeViewOptions;
@@ -3565,6 +3569,7 @@ type
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure MouseLeave; override;
     procedure NodeChanged(Node: TTreeNode; ChangeReason: TTreeNodeChangeReason); virtual;
+    function NodeHasChildren(Node: TTreeNode): Boolean; virtual;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure Paint; override;
     procedure ScrollView(DeltaX, DeltaY: Integer);
@@ -3624,6 +3629,8 @@ type
       read FOnGetImageIndex write FOnGetImageIndex;
     property OnGetSelectedIndex: TTVExpandedEvent
       read FOnGetSelectedIndex write FOnGetSelectedIndex;
+    property OnHasChildren: TTVHasChildrenEvent
+      read FOnHasChildren write FOnHasChildren;
     property OnNodeChanged: TTVNodeChangedEvent read FOnNodeChanged write FOnNodeChanged;
     property OnSelectionChanged: TNotifyEvent
       read FOnSelectionChanged write FOnSelectionChanged;
@@ -3807,6 +3814,7 @@ type
     property OnExpanding;
     property OnGetImageIndex;
     property OnGetSelectedIndex;
+    property OnHasChildren;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;

lcl/include/treeview.inc

@@ -854,6 +854,14 @@ end;
 
 function TTreeNode.GetHasChildren: Boolean;
 begin
+  if not GetState(nsValidHasChildren) then
+  begin
+    if Owner.Owner.NodeHasChildren(Self) then
+      Include(FStates, nsHasChildren)
+    else
+      Exclude(FStates, nsHasChildren);
+    Include(FStates, nsValidHasChildren);
+  end;
   Result := GetState(nsHasChildren);
 end;
 
@@ -895,7 +903,7 @@ end;
 
 procedure TTreeNode.SetHasChildren(AValue: Boolean);
 begin
-  if AValue=HasChildren then exit;
+  if GetState(nsValidHasChildren) and (AValue=HasChildren) then exit;
   //DebugLn('[TTreeNode.SetHasChildren] Self=',DbgS(Self),' Self.Text=',Text,' AValue=',AValue);
   if AValue then
     Include(FStates,nsHasChildren)
@@ -904,6 +912,7 @@ begin
       GetLastChild.Free;
     Exclude(FStates,nsHasChildren)
   end;
+  Include(FStates, nsValidHasChildren);
   Update;
 end;
 
@@ -5943,6 +5952,14 @@ begin
      OnNodeChanged(self,Node,ChangeReason);
 end;
 
+function TCustomTreeView.NodeHasChildren(Node: TTreeNode): Boolean;
+begin
+  if Assigned(FOnHasChildren) then
+    Result := FOnHasChildren(Self, Node)
+  else
+    Result := false;
+end;
+
 procedure TCustomTreeView.Notification(AComponent: TComponent; Operation: TOperation);
 begin
   inherited Notification(AComponent, Operation);

lcl/shellctrls.pas

@@ -87,6 +87,7 @@ type
     function CanExpand(Node: TTreeNode): Boolean; override;
     function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override;
     function GetBuiltinIconSize: TSize; override;
+    function NodeHasChildren(Node: TTreeNode): Boolean; override;
   public
     { Basic methods }
     constructor Create(AOwner: TComponent); override;
@@ -176,6 +177,7 @@ type
     property OnExpanding;
     property OnGetImageIndex;
     property OnGetSelectedIndex;
+    property OnHasChildren;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;
@@ -829,6 +831,54 @@ begin
     Result := IncludeTrailingPathDelimiter(Result);
 end;
 
+function TCustomShellTreeView.NodeHasChildren(Node: TTreeNode): Boolean;
+
+  function HasSubDir(Const ADir: String): Boolean;
+  var
+    SR: TSearchRec;
+    FindRes: LongInt;
+    Attr: Longint;
+    IsHidden: Boolean;
+  begin
+    Result:=False;
+    try
+      Attr := faDirectory;
+      if (otHidden in fObjectTypes) then Attr := Attr or faHidden{%H-};
+      FindRes := FindFirstUTF8(AppendPathDelim(ADir) + AllFilesMask, Attr , SR);
+      while (FindRes = 0) do
+      begin
+        if ((SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and
+           (SR.Name <> '..')) then
+        begin
+          IsHidden := ((Attr and faHidden{%H-}) > 0);
+          if not (IsHidden and (not ((otHidden in fObjectTypes)))) then
+          begin
+            Result := True;
+            Break;
+          end;
+        end;
+        FindRes := FindNextUtf8(SR);
+      end;
+    finally
+      FindCloseUTF8(SR);
+    end; //try
+  end;
+
+var
+  NodePath: String;
+begin
+  if Assigned(OnHasChildren) then
+    Result := OnHasChildren(Self, Node)
+  else
+  begin
+    NodePath := GetPathFromNode(Node);
+    if (fObjectTypes * [otNonFolders] = []) then
+      Result := TShellTreeNode(Node).IsDirectory and HasSubDir(NodePath)
+    else
+      Result := TShellTreeNode(Node).IsDirectory;
+  end;
+end;
+
 { Returns true if at least one item was added, false otherwise }
 function TCustomShellTreeView.PopulateTreeNodeWithFiles(
   ANode: TTreeNode; ANodePath: string): Boolean;
@@ -837,38 +887,6 @@ var
   Files: TStringList;
   NewNode: TTreeNode;
   CanAdd: Boolean;
-
-   function HasSubDir(Const ADir: String): Boolean;
-   var
-     SR: TSearchRec;
-     FindRes: LongInt;
-     Attr: Longint;
-     IsHidden: Boolean;
-   begin
-     Result:=False;
-     try
-       Attr := faDirectory;
-       if (otHidden in fObjectTypes) then Attr := Attr or faHidden{%H-};
-       FindRes := FindFirstUTF8(AppendPathDelim(ADir) + AllFilesMask, Attr , SR);
-       while (FindRes = 0) do
-       begin
-         if ((SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and
-            (SR.Name <> '..')) then
-         begin
-           IsHidden := ((Attr and faHidden{%H-}) > 0);
-           if not (IsHidden and (not ((otHidden in fObjectTypes)))) then
-           begin
-             Result := True;
-             Break;
-           end;
-         end;
-         FindRes := FindNextUtf8(SR);
-       end;
-     finally
-       FindCloseUTF8(SR);
-     end; //try
-   end;
-
 begin
   Result := False;
   // avoids crashes in the IDE by not populating during design
@@ -890,12 +908,8 @@ begin
         NewNode := Items.AddChildObject(ANode, Files[i], nil);
         TShellTreeNode(NewNode).FFileInfo := TFileItem(Files.Objects[i]).FileInfo;
         TShellTreeNode(NewNode).SetBasePath(TFileItem(Files.Objects[i]).FBasePath);
-
-        if (fObjectTypes * [otNonFolders] = []) then
-          NewNode.HasChildren := (TShellTreeNode(NewNode).IsDirectory and
-                                 HasSubDir(AppendpathDelim(ANodePath)+Files[i]))
-        else
-          NewNode.HasChildren := TShellTreeNode(NewNode).IsDirectory;
+        // NewNode.HasChildren will be set later when needed to avoid opening
+        // all subdirectories (--> NodeHasChildren).
       end;
     end;
   finally