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

LCL: added CreateAbsolutePath

Browse Source 
git-svn-id: trunk@26428 -
This commit is contained in:
mattias 2010-07-02 20:49:36 +00:00
parent 54aca4f0e5
commit ae9add2dd2
2 changed files with 15 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/fileutil.pas
View File

@ -91,6 +91,7 @@ function CleanAndExpandDirectory(const Filename: string): string;
function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
function CreateRelativePath(const Filename, BaseDirectory: string;
UsePointDirectory: boolean = false): string;
function CreateAbsolutePath(const Filename, BaseDirectory: string): string;
function FileIsInPath(const Filename, Path: string): boolean;
function FileIsInDirectory(const Filename, Directory: string): boolean;

14
lcl/include/fileutil.inc
View File

@ -1397,6 +1397,20 @@ begin
Result:='.'; // Filename is the BaseDirectory
end;
function CreateAbsolutePath(const Filename, BaseDirectory: string): string;
begin
if (Filename='') or FilenameIsAbsolute(Filename) then
Result:=Filename
{$IFDEF Windows}
else if (Filename[1]='\') then
// only use drive of BaseDirectory
Result:=ExtractFileDrive(BaseDirectory)+Filename
{$ENDIF}
else
Result:=AppendPathDelim(BaseDirectory)+Filename;
Result:=TrimFilename(Result);
end;
{------------------------------------------------------------------------------
function FileIsInPath(const Filename, Path: string): boolean;
------------------------------------------------------------------------------}