paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 15:53:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed DirectoryExists

Browse Source 
git-svn-id: trunk@376 -
This commit is contained in:
lazarus 2001-10-31 18:09:51 +00:00
parent 2cbcc53a57
commit 07f6e25d94
2 changed files with 11 additions and 1 deletions

3
ide/ideprocs.pp
View File

@ -44,6 +44,9 @@ end;
function DirectoryExists(DirectoryName: string): boolean;
var sr: TSearchRec;
begin
if (DirectoryName<>'')
and (DirectoryName[length(DirectoryName)]=OSDirSeparator) then
DirectoryName:=copy(DirectoryName,1,length(DirectoryName)-1);
if FindFirst(DirectoryName,faAnyFile,sr)=0 then
Result:=((sr.Attr and faDirectory)>0)
else

9
ide/main.pp
View File

@ -2325,7 +2325,8 @@ writeln('*** TMainIDE.DoOpenEditorFile START "',AFilename,'"');
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
Result:=mrCancel;
if AFileName='' then exit;
if (AFileName='') or (not FileExists(AFilename)) or (DirectoryExists(AFilename))
then exit;
Ext:=lowercase(ExtractFileExt(AFilename));
// check if the project knows this file
i:=Project.UnitCount-1;
@ -4369,6 +4370,9 @@ end.
{ =============================================================================
$Log$
Revision 1.130 2001/10/31 18:09:51 lazarus
MG: fixed DirectoryExists
Revision 1.129 2001/10/31 16:29:20 lazarus
Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
Shane
@ -8981,6 +8985,9 @@ end.
{ =============================================================================
$Log$
Revision 1.130 2001/10/31 18:09:51 lazarus
MG: fixed DirectoryExists
Revision 1.129 2001/10/31 16:29:20 lazarus
Fixed the gtk mousemove bug where the control gets the coord's based on it's parent instead of itself.
Shane