LCL: added CreateAbsolutePath

git-svn-id: trunk@26428 -

lcl/fileutil.pas

@@ -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;
 

lcl/include/fileutil.inc

@@ -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;
  ------------------------------------------------------------------------------}