paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 14:38:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/ShellTreeView: Fix error when clicking a non-default root node in sorted ShellTreeView. Issue #41373.

Browse Source
This commit is contained in:
wp_xyz 2025-02-01 12:46:38 +01:00
parent 3cc1bc02fb
commit d11d9793b2
1 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lcl/shellctrls.pas
View File

@ -89,6 +89,7 @@ type
FUseBuiltinIcons: Boolean; FUseBuiltinIcons: Boolean;
FOnAddItem: TAddItemEvent; FOnAddItem: TAddItemEvent;
FOnSortCompare: TFileItemCompareEvent; FOnSortCompare: TFileItemCompareEvent;
function CreateRootNode(const APath: String): TTreeNode;
{ Setters and getters } { Setters and getters }
function GetPath: string; function GetPath: string;
procedure SetFileSortType(const AValue: TFileSortType); procedure SetFileSortType(const AValue: TFileSortType);
@ -600,6 +601,19 @@ begin
Raise EShellCtrl.Create(sShellTreeViewIncorrectNodeType); Raise EShellCtrl.Create(sShellTreeViewIncorrectNodeType);
end; end;
function TCustomShellTreeView.CreateRootNode(const APath: string): TTreeNode;
var
dirInfo: TSearchRec;
begin
Result := Items.AddChild(nil, APath);
TShellTreeNode(Result).SetBasePath('');
FindFirstUTF8(APath, faAnyFile, dirInfo);
TShellTreeNode(Result).FFileInfo := dirInfo;
FindCloseUTF8(dirInfo);
Result.HasChildren := True;
Result.Expand(False);
end;
procedure TCustomShellTreeView.SetRoot(const AValue: string); procedure TCustomShellTreeView.SetRoot(const AValue: string);
var var
RootNode: TTreeNode; RootNode: TTreeNode;
@ -630,12 +644,7 @@ begin
//Make FRoot contain fully qualified pathname, we need it later in GetPathFromNode() //Make FRoot contain fully qualified pathname, we need it later in GetPathFromNode()
FRoot := ExpandFileNameUtf8(FRoot); FRoot := ExpandFileNameUtf8(FRoot);
//Set RootNode.Text to AValue so user can choose if text is fully qualified path or not //Set RootNode.Text to AValue so user can choose if text is fully qualified path or not
RootNode := Items.AddChild(nil, AValue); RootNode := CreateRootNode(AValue);
TShellTreeNode(RootNode).FFileInfo.Attr := FileGetAttr(FRoot);
TShellTreeNode(RootNode).FFileInfo.Name := FRoot;
TShellTreeNode(RootNode).SetBasePath('');
RootNode.HasChildren := True;
RootNode.Expand(False);
end; end;
if Assigned(ShellListView) then if Assigned(ShellListView) then
ShellListView.Root := FRoot; ShellListView.Root := FRoot;
@ -659,9 +668,7 @@ begin
PopulateWithBaseFiles() PopulateWithBaseFiles()
else else
begin begin
RootNode := Items.AddChild(nil, FRoot); RootNode := CreateRootNode(FRoot);
RootNode.HasChildren := True;
RootNode.Expand(False);
if ExistsAndIsValid(CurrPath) then if ExistsAndIsValid(CurrPath) then
SetPath(CurrPath); SetPath(CurrPath);
end; end;
@ -710,9 +717,7 @@ begin
PopulateWithBaseFiles() PopulateWithBaseFiles()
else else
begin begin
RootNode := Items.AddChild(nil, FRoot); RootNode := CreateRootNode(FRoot);
RootNode.HasChildren := True;
RootNode.Expand(False);
if ExistsAndIsValid(Currpath) then if ExistsAndIsValid(Currpath) then
SetPath(CurrPath); SetPath(CurrPath);
end; end;