LCL/ShellCtrls: New property TExpandCollapseMode. Fixes issue #40022. Partly based on patch by @d7_2_laz.

This commit is contained in:
wp_xyz 2022-11-29 12:16:57 +01:00
parent bb65b8022c
commit efd6c16934

View File

@ -37,8 +37,6 @@ uses
type type
{ TObjectTypes }
TObjectType = (otFolders, otNonFolders, otHidden); TObjectType = (otFolders, otNonFolders, otHidden);
TObjectTypes = set of TObjectType; TObjectTypes = set of TObjectType;
@ -47,6 +45,12 @@ type
TMaskCaseSensitivity = (mcsPlatformDefault, mcsCaseInsensitive, mcsCaseSensitive); TMaskCaseSensitivity = (mcsPlatformDefault, mcsCaseInsensitive, mcsCaseSensitive);
TExpandCollapseMode = (
ecmRefreshedExpanding, // Clear already existing children before expanding
ecmKeepChildren, // Do not clear children of already-expanded, but collapsed nodes
ecmCollapseAndClear // Clear children when a node is collapsed
);
{ Forward declaration of the classes } { Forward declaration of the classes }
TCustomShellTreeView = class; TCustomShellTreeView = class;
@ -62,6 +66,7 @@ type
FObjectTypes: TObjectTypes; FObjectTypes: TObjectTypes;
FRoot: string; FRoot: string;
FShellListView: TCustomShellListView; FShellListView: TCustomShellListView;
FExpandCollapseMode: TExpandCollapseMode;
FFileSortType: TFileSortType; FFileSortType: TFileSortType;
FInitialRoot: String; FInitialRoot: String;
FUseBuiltinIcons: Boolean; FUseBuiltinIcons: Boolean;
@ -85,9 +90,11 @@ type
procedure DoSelectionChanged; override; procedure DoSelectionChanged; override;
procedure DoAddItem(const ABasePath: String; const AFileInfo: TSearchRec; var CanAdd: Boolean); procedure DoAddItem(const ABasePath: String; const AFileInfo: TSearchRec; var CanAdd: Boolean);
function CanExpand(Node: TTreeNode): Boolean; override; function CanExpand(Node: TTreeNode): Boolean; override;
procedure Collapse(Node: TTreeNode); override;
function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override; function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override;
function GetBuiltinIconSize: TSize; override; function GetBuiltinIconSize: TSize; override;
function NodeHasChildren(Node: TTreeNode): Boolean; override; function NodeHasChildren(Node: TTreeNode): Boolean; override;
property ExpandCollapseMode: TExpandCollapseMode read FExpandCollapseMode write FExpandCollapseMode default ecmRefreshedExpanding;
public public
{ Basic methods } { Basic methods }
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -129,6 +136,7 @@ type
property Color; property Color;
property Constraints; property Constraints;
property Enabled; property Enabled;
property ExpandCollapseMode;
property ExpandSignType; property ExpandSignType;
property Font; property Font;
property FileSortType; property FileSortType;
@ -625,14 +633,46 @@ begin
AutoExpand:=False; AutoExpand:=False;
BeginUpdate; BeginUpdate;
try try
Node.DeleteChildren; case FExpandCollapseMode of
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node)); ecmRefreshedExpanding:
begin
Node.DeleteChildren;
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
end;
ecmKeepChildren:
if Node.Count = 0 then
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node))
else
Result := true;
ecmCollapseAndClear:
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
end;
AutoExpand:=OldAutoExpand; AutoExpand:=OldAutoExpand;
finally finally
EndUpdate; EndUpdate;
end; end;
end; end;
procedure TCustomShellTreeView.Collapse(Node: TTreeNode);
var
hadChildren: Boolean;
begin
if csDestroying in ComponentState then
exit;
if ExpandCollapseMode = ecmCollapseAndClear then
begin
BeginUpdate;
try
hadChildren := Node.HasChildren;
Node.DeleteChildren;
Node.HasChildren := hadChildren;
finally
EndUpdate;
end;
end;
inherited;
end;
constructor TCustomShellTreeView.Create(AOwner: TComponent); constructor TCustomShellTreeView.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);