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

win32: fix OpenDialog.FileName retrieving when FileName already contains path (#0012364)

Browse Source 
git-svn-id: trunk@16977 -
This commit is contained in:
paul 2008-10-12 08:54:29 +00:00
parent d15a65ac56
commit 294989aa80
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/interfaces/win32/win32wsdialogs.pp
View File

@ -173,10 +173,19 @@ var
AOpenDialog: TOpenDialog; AOpenDialog: TOpenDialog;
procedure SetFilesPropertyCustomFiles(AFiles:TStrings); procedure SetFilesPropertyCustomFiles(AFiles:TStrings);
procedure AddFile(FolderName, FileName: String); inline;
begin
if ExtractFilePath(FileName) = '' then
AFiles.Add(FolderName + FileName)
else
AFiles.Add(FileName);
end;
var var
i, Start, len: integer; i, Start, len: integer;
FolderName: string; FolderName: string;
FileNames: String; FileNames: string;
begin begin
{$ifdef WindowsUnicodeSupport} {$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then if UnicodeEnabledOS then
@ -203,14 +212,14 @@ var
i := Start + 1; i := Start + 1;
while FileNames[i] <> '"' do while FileNames[i] <> '"' do
inc(i); inc(i);
AFiles.Add(FolderName + Copy(FileNames, Start + 1, I - Start - 1)); AddFile(FolderName, Copy(FileNames, Start + 1, I - Start - 1));
start := i+1; Start := i + 1;
while (start <= len) and (FileNames[Start] <> #0) and (FileNames[start] <> '"') do while (Start <= len) and (FileNames[Start] <> #0) and (FileNames[Start] <> '"') do
inc(Start); inc(Start);
end; end;
end end
else else
AFiles.Add(FolderName + FileNames); AddFile(FolderName, FileNames);
end; end;
procedure SetFilesPropertyForOldStyle(AFiles:TStrings); procedure SetFilesPropertyForOldStyle(AFiles:TStrings);