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

LCL: Fix ShellTreeView's new property Path. Issue #22538, modified from patch of "ocean"

Browse Source 
git-svn-id: trunk@38221 -
This commit is contained in:
juha 2012-08-09 23:31:00 +00:00
parent 75b969e9cb
commit 5b3c99a51b
1 changed files with 24 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lcl/shellctrls.pas
View File

@ -76,7 +76,7 @@ type
class procedure GetFilesInDir(const ABaseDir: string; class procedure GetFilesInDir(const ABaseDir: string;
AMask: string; AObjectTypes: TObjectTypes; AResult: TStrings; AFileSortType: TFileSortType = fstNone); AMask: string; AObjectTypes: TObjectTypes; AResult: TStrings; AFileSortType: TFileSortType = fstNone);
{ Other methods specific to Lazarus } { Other methods specific to Lazarus }
function GetPathFromNode(ANode: TTreeNode; AIncludeRoot: Boolean = True): string; function GetPathFromNode(ANode: TTreeNode): string;
function GetSelectedNodePath: string; function GetSelectedNodePath: string;
{ Properties } { Properties }
@ -117,7 +117,6 @@ type
property ParentColor default False; property ParentColor default False;
property ParentFont; property ParentFont;
property ParentShowHint; property ParentShowHint;
property Path;
property PopupMenu; property PopupMenu;
property ReadOnly; property ReadOnly;
property RightClickSelect; property RightClickSelect;
@ -579,8 +578,11 @@ end;
function TCustomShellTreeView.GetRootPath: string; function TCustomShellTreeView.GetRootPath: string;
begin begin
if FRoot <> '' then Result := FRoot if FRoot <> '' then
else Result := GetBasePath(); Result := FRoot
else
Result := GetBasePath();
if Result <> '' then
Result := IncludeTrailingPathDelimiter(Result); Result := IncludeTrailingPathDelimiter(Result);
end; end;
@ -673,26 +675,20 @@ begin
FShellListView.Root := GetPathFromNode(Selected); FShellListView.Root := GetPathFromNode(Selected);
end; end;
function TCustomShellTreeView.GetPathFromNode(ANode: TTreeNode; AIncludeRoot: Boolean): string; function TCustomShellTreeView.GetPathFromNode(ANode: TTreeNode): string;
var
nodeDir: string;
begin begin
nodeDir := ''; Result := '';
if ANode <> nil then // Will return the root if nothing is selected (ANode=nil) if ANode <> nil then // Will return the root if nothing is selected (ANode=nil)
begin begin
// Build the path. In the future use ANode.Data instead of ANode.Text // Build the path. In the future use ANode.Data instead of ANode.Text
nodeDir := ANode.Text; Result := ANode.Text;
while (ANode.Parent <> nil) do while (ANode.Parent <> nil) do
begin begin
ANode := ANode.Parent; ANode := ANode.Parent;
nodeDir := IncludeTrailingPathDelimiter(ANode.Text) + nodeDir; Result := IncludeTrailingPathDelimiter(ANode.Text) + Result;
end; end;
end; end;
// Check if root directory should be included Result := GetRootPath() + Result; // Include root directory
if AIncludeRoot then
Result := GetRootPath() + nodeDir
else
Result := nodeDir;
end; end;
function TCustomShellTreeView.GetSelectedNodePath: string; function TCustomShellTreeView.GetSelectedNodePath: string;
@ -702,7 +698,7 @@ end;
function TCustomShellTreeView.GetPath: string; function TCustomShellTreeView.GetPath: string;
begin begin
Result := GetPathFromNode(Selected, False); Result := GetPathFromNode(Selected);
end; end;
procedure TCustomShellTreeView.SetPath(AValue: string); procedure TCustomShellTreeView.SetPath(AValue: string);
@ -711,9 +707,17 @@ var
Node: TTreeNode; Node: TTreeNode;
i: integer; i: integer;
begin begin
// We got a full path, make it relative if DirectoryExistsUTF8(AValue) then begin
if DirectoryExistsUTF8(AValue) then // We got a full path, make it relative to root
AValue := CreateRelativePath(AValue, GetRootPath()); if FRoot = '' then
AValue := IncludeLeadingPathDelimiter(AValue) // No root, make sure path is full
else if FRoot = PathDelim then
AValue := ExcludeLeadingPathDelimiter(AValue) // Make relative to top dir ('/')
else
// When issue #22603 is fixed, this can be replaced with:
// AValue := CreateRelativePath(AValue, GetRootPath());
Avalue := Stringreplace(AValue, GetRootPath(), '', []);
end;
// Make sure the path is correct now // Make sure the path is correct now
if not DirectoryExistsUTF8(GetRootPath()+AValue) then Exit; if not DirectoryExistsUTF8(GetRootPath()+AValue) then Exit;
sl := TStringList.Create; sl := TStringList.Create;