paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-26 03:56:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/ShellCtrls: Improved updating of ShellListView (based on code by d7_2_laz)

Browse Source
This commit is contained in:
wp_xyz 2023-11-17 22:40:30 +01:00
parent 575e58d312
commit 4b6c4e06e3
1 changed files with 37 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lcl/shellctrls.pas
View File

@ -1230,6 +1230,27 @@ end;
file system. Collapsed nodes will be updated anyway when they are expanded. } file system. Collapsed nodes will be updated anyway when they are expanded. }
procedure TCustomShellTreeView.UpdateView(AStartDir: String = ''); procedure TCustomShellTreeView.UpdateView(AStartDir: String = '');
function FindExistingSubPath(APath: String): String;
var
path: String;
i: Integer;
begin
APath := AppendPathDelim(APath);
Result := APath;
for i := 1 to Length(APath) do
begin
if APath[i] = PathDelimiter then
begin
path := Copy(APath, 1, i);
if Exists(path) then
Result := path
else
break;
end;
end;
Result := ChompPathDelim(Result);
end;
procedure RecordNodeState(const ANode: TTreeNode; const AExpandedPaths: TStringList); procedure RecordNodeState(const ANode: TTreeNode; const AExpandedPaths: TStringList);
var var
currentNode: TTreeNode; currentNode: TTreeNode;
@ -1276,10 +1297,12 @@ procedure TCustomShellTreeView.UpdateView(AStartDir: String = '');
var var
node: TTreeNode; node: TTreeNode;
firstNode: TTreeNode; firstNode: TTreeNode;
startNode: TTreeNode;
topNodePath: String; topNodePath: String;
selectedPath: String; selectedPath: String;
selectedWasExpanded: Boolean = false; selectedWasExpanded: Boolean = false;
expandedPaths: TStringList; expandedPaths: TStringList;
listviewRefreshNeeded: Boolean;
begin begin
if FUpdateLock <> 0 then if FUpdateLock <> 0 then
exit; exit;
@ -1294,17 +1317,22 @@ begin
firstNode := Items.GetFirstNode; firstNode := Items.GetFirstNode;
if AStartDir = '' then if AStartDir = '' then
node := firstNode
else
begin begin
node := Items.FindNodeWithTextPath(ChompPathDelim(AStartDir)); startNode := firstNode;
// Avoid starting at a non-existing folder listViewRefreshNeeded := true;
while not Exists(GetPathFromNode(node)) and (node <> firstNode) do end else
node := node.Parent; begin
// Make sure that AStartDir is a valid, existing path. If not, go back in
// hierarchy until a valid subpath is found.
startNode := Items.FindNodeWithTextPath(FindExistingSubPath(AStartDir));
// Set a flag to refresh the ShellListView if affected by the refresh.
listViewRefreshNeeded := (AStartDir = '') or (startNode = Selected);
if (Selected = nil) and Assigned(FShellListView) then
listViewRefreshNeeded := (FShellListView.Items.Count> 0);
end; end;
RecordNodeState(node, expandedPaths); RecordNodeState(startNode, expandedPaths);
RestoreNodeState(node, true, expandedPaths); RestoreNodeState(startNode, true, expandedPaths);
if Exists(selectedPath) then if Exists(selectedPath) then
begin begin
@ -1317,8 +1345,7 @@ begin
// Force synchronization of associated ShellListView, but only if the // Force synchronization of associated ShellListView, but only if the
// refresh affects the selected tree node. // refresh affects the selected tree node.
if Assigned(FShellListView) and if Assigned(FShellListView) and listViewRefreshNeeded then
not ((AStartDir <> '') and (pos(AStartDir, FShellListView.FRoot) = 0)) then
begin begin
inc(FUpdateLock); inc(FUpdateLock);
try try