diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index d3d238e3b7..f19044156e 100644 --- a/lcl/comctrls.pp +++ b/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; diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index bd6a0ac595..de40fbbbcc 100644 --- a/lcl/include/treeview.inc +++ b/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); diff --git a/lcl/shellctrls.pas b/lcl/shellctrls.pas index 15fe046d78..72d7d1a1dd 100644 --- a/lcl/shellctrls.pas +++ b/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