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

ShellTreeView: refresh the tree when ObjectTypes is changed. Based upon a patch by theo.

Browse Source 
git-svn-id: trunk@47743 -
This commit is contained in:
bart 2015-02-13 17:24:40 +00:00
parent 2dce61002c
commit d54f5572fa
1 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/shellctrls.pas
View File

@ -57,6 +57,7 @@ type
{ Setters and getters }
function GetPath: string;
procedure SetFileSortType(const AValue: TFileSortType);
procedure SetObjectTypes(AValue: TObjectTypes);
procedure SetPath(AValue: string);
procedure SetRoot(const AValue: string);
procedure SetShellListView(const Value: TCustomShellListView);
@ -84,7 +85,7 @@ type
procedure Refresh(ANode: TTreeNode); overload;
{ Properties }
property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes;
property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes;
property ShellListView: TCustomShellListView read FShellListView write SetShellListView;
property FileSortType: TFileSortType read FFileSortType write SetFileSortType;
property Root: string read FRoot write SetRoot;
@ -457,6 +458,28 @@ begin
end;
end;
procedure TCustomShellTreeView.SetObjectTypes(AValue: TObjectTypes);
var
CurrPath: String;
begin
if FObjectTypes = AValue then Exit;
FObjectTypes := AValue;
if (csLoading in ComponentState) then Exit;
CurrPath := GetPath;
try
BeginUpdate;
Refresh(nil);
try
SetPath(CurrPath);
except
// CurrPath may have been removed in the mean time by another process, just ignore
on E: EInvalidPath do ;//
end;
finally
EndUpdate;
end;
end;
function TCustomShellTreeView.CanExpand(Node: TTreeNode): Boolean;
var
OldAutoExpand: Boolean;