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

TShellTreeView:

Browse Source 
- Yet another attempt to fix SetPath (Issue #0026088)
- Ifdef the code for debug output.

git-svn-id: trunk@50648 -
This commit is contained in:
bart 2015-12-05 16:42:43 +00:00
parent 82b946cccb
commit c45aa54c62
1 changed files with 84 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
lcl/shellctrls.pas
View File

@ -17,11 +17,13 @@ unit ShellCtrls;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$define debug_shellctrls}
interface interface
uses uses
Classes, SysUtils, Forms, Graphics, LCLType, AvgLvlTree, Classes, SysUtils, Forms, Graphics, LCLType, AvgLvlTree,
ComCtrls, FileUtil, LazFileUtils, LazUtf8, LCLStrConsts; ComCtrls, FileUtil, LazFileUtils, LazUtf8, LCLStrConsts, LCLProc;
{$if defined(Windows) or defined(darwin)} {$if defined(Windows) or defined(darwin)}
{$define CaseInsensitiveFilenames} {$define CaseInsensitiveFilenames}
@ -947,9 +949,16 @@ var
IsRoot: Boolean; IsRoot: Boolean;
begin begin
if (Items.Count = 0) then Exit; if (Items.Count = 0) then Exit;
//writeln('GetFirstVisibleNode.Text = "',Items.GetFirstVisibleNode.Text,'"'); {$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.Refresh: GetFirstVisibleNode.Text = "',Items.GetFirstVisibleNode.Text,'"']);
{$endif}
IsRoot := (ANode = nil) or ((ANode = Items.GetFirstVisibleNode) and (GetRootPath <> '')); IsRoot := (ANode = nil) or ((ANode = Items.GetFirstVisibleNode) and (GetRootPath <> ''));
//writeln('IsRoot = ',IsRoot); {$ifdef debug_shellctrls}
debugln(['IsRoot = ',IsRoot]);
{$endif}
if (ANode = nil) and (GetRootPath <> '') then ANode := Items.GetFirstVisibleNode; if (ANode = nil) and (GetRootPath <> '') then ANode := Items.GetFirstVisibleNode;
if IsRoot then if IsRoot then
begin begin
@ -957,7 +966,11 @@ begin
RootNodeText := ANode.Text //this may differ from FRoot, so don't use FRoot here RootNodeText := ANode.Text //this may differ from FRoot, so don't use FRoot here
else else
RootNodeText := GetRootPath; RootNodeText := GetRootPath;
//writeln('IsRoot = TRUE, RootNodeText = "',RootNodeText,'"'); {$ifdef debug_shellctrls}
debugln(['IsRoot = TRUE, RootNodeText = "',RootNodeText,'"']);
{$endif}
FRoot := #0; //invalidate FRoot FRoot := #0; //invalidate FRoot
SetRoot(RootNodeText); //re-initialize the entire tree SetRoot(RootNodeText); //re-initialize the entire tree
end end
@ -1010,13 +1023,17 @@ var
begin begin
Result := False; Result := False;
Attr := FileGetAttrUtf8(Fn); Attr := FileGetAttrUtf8(Fn);
//writeln('TCustomShellTreeView.SetPath.Exists: Attr = ', Attr); {$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Attr = ', Attr]);
{$endif}
if (Attr = -1) then Exit; if (Attr = -1) then Exit;
if not (otNonFolders in FObjectTypes) then if not (otNonFolders in FObjectTypes) then
Result := ((Attr and faDirectory) > 0) Result := ((Attr and faDirectory) > 0)
else else
Result := True; Result := True;
//writeln('TCustomShellTreeView.SetPath.Exists: Result = ',Result); {$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: Result = ',Result]);
{$endif}
end; end;
function PathIsDriveRoot({%H-}Path: String): Boolean; {$if not (defined(windows) and not defined(wince))}inline;{$endif} function PathIsDriveRoot({%H-}Path: String): Boolean; {$if not (defined(windows) and not defined(wince))}inline;{$endif}
@ -1068,7 +1085,9 @@ var
//don't check if Fn now is "higher up the tree" than the current root //don't check if Fn now is "higher up the tree" than the current root
if (RelPath = '') or ((Length(RelPath) > 1) and (RelPath[1] = '.') and (RelPath[2] = '.')) then if (RelPath = '') or ((Length(RelPath) > 1) and (RelPath[1] = '.') and (RelPath[2] = '.')) then
begin begin
//writeln('Fn is higher: ',Fn); {$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.ContainsHidden: Fn is higher: ',Fn]);
{$endif}
Continue; Continue;
end; end;
{$if defined(windows) and not defined(wince)} {$if defined(windows) and not defined(wince)}
@ -1078,7 +1097,9 @@ var
if (Attr <> -1) and ((Attr and faHidden) > 0) and not PathIsDriveRoot(Fn) then if (Attr <> -1) and ((Attr and faHidden) > 0) and not PathIsDriveRoot(Fn) then
begin begin
Result := True; Result := True;
//writeln('TCustomShellTreeView.SetPath.Exists: a subdir is hidden: Result := False'); {$ifdef debug_shellctrls}
debugln(['TCustomShellTreeView.SetPath.Exists: a subdir is hidden: Result := False']);
{$endif}
Break; Break;
end; end;
end; end;
@ -1092,8 +1113,9 @@ var
begin begin
RelPath := ''; RelPath := '';
//writeln('SetPath: GetRootPath = "',getrootpath,'"',' AValue=',AValue); {$ifdef debug_shellctrls}
debugln(['SetPath: GetRootPath = "',getrootpath,'"',' AValue=',AValue]);
{$endif}
if (GetRootPath <> '') then if (GetRootPath <> '') then
//FRoot is already Expanded in SetRoot, just add PathDelim if needed //FRoot is already Expanded in SetRoot, just add PathDelim if needed
FQRootPath := AppendPathDelim(GetRootPath) FQRootPath := AppendPathDelim(GetRootPath)
@ -1102,12 +1124,11 @@ begin
RootIsAbsolute := (FQRootPath = '') or (FQRootPath = PathDelim) RootIsAbsolute := (FQRootPath = '') or (FQRootPath = PathDelim)
or ((Length(FQRootPath) = 3) and (FQRootPath[2] = ':') and (FQRootPath[3] = PathDelim)); or ((Length(FQRootPath) = 3) and (FQRootPath[2] = ':') and (FQRootPath[3] = PathDelim));
//writeln('SetPath: FQRootPath = ',fqrootpath); {$ifdef debug_shellctrls}
//writeln('SetPath: RootIsAbsolute = ',RootIsAbsolute); debugln(['SetPath: FQRootPath = ',fqrootpath]);
debugln(['SetPath: RootIsAbsolute = ',RootIsAbsolute]);
//IsRelPath := not FileNameIsAbsolute(AValue); debugln(['SetPath: FilenameIsAbsolute = ',FileNameIsAbsolute(AValue)]);
{$endif}
//writeln('SetPath: IsRelPath = ',not FileNameIsAbsolute(AValue));
if not FileNameIsAbsolute(AValue) then if not FileNameIsAbsolute(AValue) then
begin begin
@ -1139,11 +1160,12 @@ begin
//RelPath := CreateRelativePath(AValue, FQRootPath, False); //RelPath := CreateRelativePath(AValue, FQRootPath, False);
IsRelPath := (FQRootPath = '') or TryCreateRelativePath(AValue, FQRootPath, False, True, RelPath); IsRelPath := (FQRootPath = '') or TryCreateRelativePath(AValue, FQRootPath, False, True, RelPath);
//writeln('TCustomShellTreeView.SetPath: '); {$ifdef debug_shellctrls}
//writeln(' IsRelPath = ',IsRelPath); debugln('TCustomShellTreeView.SetPath: ');
//writeln(' RelPath = "',RelPath,'"'); debugln([' IsRelPath = ',IsRelPath]);
//writeln(' FQRootPath = "',FQRootPath,'"'); debugln([' RelPath = "',RelPath,'"']);
debugln([' FQRootPath = "',FQRootPath,'"']);
{$endif}
if (not IsRelpath) or ((RelPath <> '') and ((Length(RelPath) > 1) and (RelPath[1] = '.') and (RelPath[2] = '.'))) then if (not IsRelpath) or ((RelPath <> '') and ((Length(RelPath) > 1) and (RelPath[1] = '.') and (RelPath[2] = '.'))) then
begin begin
@ -1154,10 +1176,15 @@ begin
if (RelPath = '') and (FQRootPath = '') then if (RelPath = '') and (FQRootPath = '') then
RelPath := AValue; RelPath := AValue;
//writeln('RelPath = ',RelPath); {$ifdef debug_shellctrls}
debugln(['RelPath = ',RelPath]);
{$endif}
if (RelPath = '') then if (RelPath = '') then
begin begin
//writeln('Root selected'); {$ifdef debug_shellctrls}
debugln('Root selected');
{$endif}
Node := Items.GetFirstVisibleNode; Node := Items.GetFirstVisibleNode;
if Assigned(Node) then if Assigned(Node) then
begin begin
@ -1183,30 +1210,41 @@ begin
Exit; Exit;
end; end;
//for i := 0 to sl.Count - 1 do writeln('sl[',i:2,']="',sl[i],'"'); {$ifdef debug_shellctrls}
for i := 0 to sl.Count - 1 do debugln(['sl[',i,']="',sl[i],'"']);
{$endif}
BeginUpdate; BeginUpdate;
try try
Node := Items.GetFirstVisibleNode; Node := Items.GetFirstVisibleNode;
//if assigned(node) then writeln('GetFirstVisibleNode = ',GetAdjustedNodeText(Node)); {$ifdef debug_shellctrls}
//Root node doesn't have Siblings in this case, we need one level deeper if assigned(node) then debugln(['GetFirstVisibleNode = ',GetAdjustedNodeText(Node)]);
{$endif}
//Root node doesn't have Siblings in this case, we need one level down the tree
if (GetRootPath <> '') and Assigned(Node) then if (GetRootPath <> '') and Assigned(Node) then
begin begin
//writeln('Root node doesn''t have Siblings'); {$ifdef debug_shellctrls}
debugln('Root node doesn''t have Siblings');
{$endif}
Node := Node.GetFirstVisibleChild; Node := Node.GetFirstVisibleChild;
//writeln('Node = ',GetAdjustedNodeText(Node)); {$ifdef debug_shellctrls}
if RootIsAbsolute then sl.Delete(0); debugln(['Node = ',GetAdjustedNodeText(Node)]);
{$endif}
//I don't know why I wrote this in r44893, but it seems to be wrong so I comment it out
//for the time being (2015-12-05: BB)
//if RootIsAbsolute then sl.Delete(0);
end; end;
for i := 0 to sl.Count-1 do for i := 0 to sl.Count-1 do
begin begin
{ {$ifdef debug_shellctrls}
write('i=',i,' sl[',i,']=',sl[i],' '); DbgOut(['i=',i,' sl[',i,']=',sl[i],' ']);
if Node <> nil then write('GetAdjustedNodeText = ',GetAdjustedNodeText(Node)) if Node <> nil then DbgOut(['GetAdjustedNodeText = ',GetAdjustedNodeText(Node)])
else write('Node = NIL'); else DbgOut('Node = NIL');
writeln; debugln;
} {$endif}
while (Node <> Nil) and while (Node <> Nil) and
{$IF defined(CaseInsensitiveFilenames) or defined(NotLiteralFilenames)} {$IF defined(CaseInsensitiveFilenames) or defined(NotLiteralFilenames)}
(Utf8LowerCase(GetAdjustedNodeText(Node)) <> Utf8LowerCase(sl[i])) (Utf8LowerCase(GetAdjustedNodeText(Node)) <> Utf8LowerCase(sl[i]))
@ -1215,13 +1253,15 @@ begin
{$ENDIF} {$ENDIF}
do do
begin begin
//write(' i=',i,' "',GetAdjustedNodeText(Node),' <> ',sl[i],' -> GetNextVisibleSibling -> '); {$ifdef debug_shellctrls}
DbgOut([' i=',i,' "',GetAdjustedNodeText(Node),' <> ',sl[i],' -> GetNextVisibleSibling -> ']);
{$endif}
Node := Node.GetNextVisibleSibling; Node := Node.GetNextVisibleSibling;
{ {$ifdef debug_shellctrls}
if Node <> nil then write('GetAdjustedNodeText = ',GetAdjustedNodeText(Node)) if Node <> nil then DbgOut(['GetAdjustedNodeText = ',GetAdjustedNodeText(Node)])
else write('Node = NIL'); else DbgOut('Node = NIL');
writeln; debugln;
} {$endif}
end; end;
if Node <> Nil then if Node <> Nil then
begin begin
@ -1371,7 +1411,7 @@ procedure TCustomShellListView.Resize;
begin begin
inherited Resize; inherited Resize;
{$ifdef DEBUG_SHELLCTRLS} {$ifdef DEBUG_SHELLCTRLS}
WriteLn(':>TCustomShellListView.HandleResize'); debugln(':>TCustomShellListView.HandleResize');
{$endif} {$endif}
// The correct check is with count, // The correct check is with count,
@ -1396,9 +1436,9 @@ begin
end; end;
{$ifdef DEBUG_SHELLCTRLS} {$ifdef DEBUG_SHELLCTRLS}
WriteLn(':<TCustomShellListView.HandleResize C0.Width=', debugln([':<TCustomShellListView.HandleResize C0.Width=',
Column[0].Width, ' C1.Width=', Column[1].Width, Column[0].Width, ' C1.Width=', Column[1].Width,
' C2.Width=', Column[2].Width); ' C2.Width=', Column[2].Width]);
{$endif} {$endif}
end; end;