paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-07 23:20:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 47743 #d54f5572fa from trunk:

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

git-svn-id: branches/fixes_1_4@47763 -
This commit is contained in:
maxim 2015-02-14 00:50:44 +00:00
parent 6394f9a7c7
commit e36faf6ed1
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;