paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-09 12:18:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/ShellCtrls: Add method UpdateView to TShellTreeView and TShellListView which updates these controls and keeps the selection and the expanded nodes. Based on patch by tcrass (https://forum.lazarus.freepascal.org/index.php/topic,65100.msg495622.html).

Browse Source
This commit is contained in:
wp_xyz 2023-11-05 16:20:36 +01:00
parent 2113ad4fef
commit 8fa26c3c71
1 changed files with 128 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

150
lcl/shellctrls.pas
View File

@ -110,6 +110,7 @@ type
function CanExpand(Node: TTreeNode): Boolean; override;
procedure Collapse(Node: TTreeNode); override;
function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override;
function Exists(APath: String): Boolean;
function GetBuiltinIconSize: TSize; override;
function NodeHasChildren(Node: TTreeNode): Boolean; override;
property ExpandCollapseMode: TExpandCollapseMode read FExpandCollapseMode write FExpandCollapseMode default ecmRefreshedExpanding;
@ -125,6 +126,7 @@ type
function GetPathFromNode(ANode: TTreeNode): string;
procedure PopulateWithBaseFiles;
procedure Refresh(ANode: TTreeNode); overload;
procedure UpdateView;
property UseBuiltinIcons: Boolean read FUseBuiltinIcons write SetUseBuiltinIcons default true;
{ Properties }
@ -257,6 +259,7 @@ type
FRoot: string;
FShellTreeView: TCustomShellTreeView;
FUseBuiltInIcons: Boolean;
FLockUpdate: Integer;
FOnAddItem: TAddItemEvent;
FOnFileAdded: TCSLVFileAddedEvent;
{ Setters and getters }
@ -282,6 +285,7 @@ type
destructor Destroy; override;
{ Methods specific to Lazarus }
function GetPathFromItem(ANode: TListItem): string;
procedure UpdateView;
{ Properties }
property AutoSizeColumns: Boolean read FAutoSizeColumns write SetAutoSizeColumns default true;
property Mask: string read FMask write SetMask; // Can be used to conect to other controls
@ -1231,11 +1235,113 @@ begin
end;
end;
procedure TCustomShellTreeView.UpdateView;
procedure RecordNodeState(const ANode: TTreeNode; const AExpandedPaths: TStringList);
var
currentNode: TTreeNode;
firstChild: TTreeNode;
begin
currentNode := ANode;
while currentNode <> nil do
begin
if currentNode.Expanded then
begin
AExpandedPaths.Add(GetPathFromNode(currentNode));
firstChild := currentNode.GetFirstChild();
if firstChild <> nil then
RecordNodeState(firstChild, AExpandedPaths);
end;
currentNode := currentNode.GetNextSibling();
end;
end;
procedure RestoreNodeState(const ANode: TTreeNode; const ARefresh: boolean;
const AExpandedPaths: TStringList);
var
currentNode: TTreeNode;
firstChild: TTreeNode;
begin
currentNode := ANode;
while currentNode <> nil do
begin
if AExpandedPaths.IndexOf(GetPathFromNode(currentNode)) >= 0 then
begin
currentNode.Expanded := True;
if ARefresh then
Refresh(currentNode);
firstChild := currentNode.GetFirstChild();
if firstChild <> nil then
RestoreNodeState(firstChild, ARefresh, AExpandedPaths);
end
else
currentNode.Expanded := False;
currentNode := currentNode.GetNextSibling();
end;
end;
var
node: TTreeNode;
topNodePath: String;
selectedPath: String;
selectedWasExpanded: Boolean = false;
expandedPaths: TStringList;
begin
expandedPaths := TStringList.Create;
Items.BeginUpdate;
try
topNodePath := ChompPathDelim(GetPathFromNode(TopItem));
selectedPath := GetPathFromNode(Selected);
if Assigned(Selected) then
selectedWasExpanded := Selected.Expanded;
node := Items.GetFirstNode;
RecordNodeState(node, expandedPaths);
RestoreNodeState(node, true, expandedPaths);
if Exists(selectedPath) then
begin
Path := selectedPath;
// Setting the path expands the selected node --> apply the stored state.
Selected.Expanded := selectedWasExpanded;
// Avoid selected node to scroll away.
TopItem := Items.FindNodeWithTextPath(topNodePath);
end;
// Force synchronization of associated ShellListView
if Assigned(FShellListView) then
FShellListView.UpdateView;
finally
Items.EndUpdate;
expandedPaths.Free;
end;
end;
function TCustomShellTreeView.GetPath: string;
begin
Result := GetPathFromNode(Selected);
end;
function TCustomShellTreeView.Exists(APath: String): Boolean;
// APath should be fully qualified
var
Attr: LongInt;
begin
Result := False;
Attr := FileGetAttrUtf8(APath);
{$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Attr = ', Attr]);
{$endif}
if (Attr = -1) then Exit;
if not (otNonFolders in FObjectTypes) then
Result := ((Attr and faDirectory) > 0)
else
Result := True;
{$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Result = ',Result]);
{$endif}
end;
{
SetPath: Path can be
- Absolute like '/usr/lib'
@ -1265,28 +1371,6 @@ var
else Result := ANode.Text;
end;
function Exists(Fn: String): Boolean;
//Fn should be fully qualified
var
Attr: LongInt;
Dirs: TStringList;
i: Integer;
begin
Result := False;
Attr := FileGetAttrUtf8(Fn);
{$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Attr = ', Attr]);
{$endif}
if (Attr = -1) then Exit;
if not (otNonFolders in FObjectTypes) then
Result := ((Attr and faDirectory) > 0)
else
Result := True;
{$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Result = ',Result]);
{$endif}
end;
function PathIsDriveRoot({%H-}Path: String): Boolean; {$if not (defined(windows) and not defined(wince))}inline;{$endif}
//WinNT filesystem reports faHidden on all physical drive-roots (e.g. C:\)
begin
@ -1808,6 +1892,28 @@ begin
Result := IncludeTrailingPathDelimiter(FRoot) + ANode.Caption;
end;
procedure TCustomShellListView.UpdateView;
var
selectedItem: String = '';
begin
if (FLockUpdate = 0) then
begin
if Assigned(Selected) then
selectedItem := Selected.Caption;
Clear;
PopulateWithRoot;
if selectedItem <> '' then
Selected := FindCaption(0, selectedItem, false, true, false);
inc(FLockUpdate);
try
ShellTreeView.UpdateView;
finally
dec(FLockUpdate);
end;
end;
end;
class procedure TCustomShellListView.WSRegisterClass;
begin
inherited WSRegisterClass;