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

ShellCtrls: Raise an exception when trying to set an invalid Root for TShellTreeView and TShellListview (Delphi compatibility).

Browse Source 
git-svn-id: trunk@40734 -
This commit is contained in:
bart 2013-04-07 13:11:04 +00:00
parent a0924e6248
commit b379a5290b
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/shellctrls.pas
View File

@ -269,6 +269,10 @@ type
property ShellTreeView; property ShellTreeView;
end; end;
const
//ToDo: make it a resource string
SShellCtrlsInvalidRoot = '%s is not a valid path.';
procedure Register; procedure Register;
implementation implementation
@ -342,6 +346,11 @@ var
begin begin
//ToDo: raise an exception if AValue is not valid //ToDo: raise an exception if AValue is not valid
if FRoot=AValue then exit; if FRoot=AValue then exit;
//Delphi raises an unspecified exception in this case, but don't crash the IDE at designtime
if not (csDesigning in ComponentState)
and (AValue <> '')
and not DirectoryExistsUtf8(ExcludeTrailingPathDelimiter(ExpandFilename(AValue))) then
Raise Exception.CreateFmt(SShellCtrlsInvalidRoot,[AValue]);
FRoot:=AValue; FRoot:=AValue;
Items.Clear; Items.Clear;
if FRoot = '' then if FRoot = '' then
@ -806,6 +815,11 @@ procedure TCustomShellListView.SetRoot(const Value: string);
begin begin
if FRoot <> Value then if FRoot <> Value then
begin begin
//Delphi raises an unspecified exception in this case, but don't crash the IDE at designtime
if not (csDesigning in ComponentState)
and (Value <> '')
and not DirectoryExistsUtf8(ExcludeTrailingPathDelimiter(ExpandFilename(Value))) then
Raise Exception.CreateFmt(SShellCtrlsInvalidRoot,[Value]);
FRoot := Value; FRoot := Value;
Clear; Clear;
Items.Clear; Items.Clear;