mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-28 22:20:25 +02:00
win32: simplify FileDialog handling:
- always use our own buffer for file names - invoke DoSelectionChange on file selection changed - update dialog Files, FileName props on selection change git-svn-id: trunk@16845 -
This commit is contained in:
paul
parent
36f21372de
commit
771a7ee01f
@ -56,6 +56,14 @@ uses
|
|||||||
Win32Proc;
|
Win32Proc;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
TOpenFileDialogRec = record
|
||||||
|
Dialog: TFileDialog;
|
||||||
|
AnsiFolderName: string;
|
||||||
|
AnsiFileNames: string;
|
||||||
|
UnicodeFolderName: widestring;
|
||||||
|
UnicodeFileNames: widestring
|
||||||
|
end;
|
||||||
|
POpenFileDialogRec = ^TOpenFileDialogRec;
|
||||||
|
|
||||||
{ TWin32WSCommonDialog }
|
{ TWin32WSCommonDialog }
|
||||||
|
|
||||||
@ -130,19 +138,11 @@ type
|
|||||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function OpenFileDialogCallBack(hWnd: Handle; uMsg: UINT; wParam: WPARAM;
|
||||||
|
lParam: LPARAM): UINT; stdcall;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
type
|
|
||||||
TOpenFileDialogRec = record
|
|
||||||
Dialog: TFileDialog;
|
|
||||||
AnsiFolderName: string;
|
|
||||||
AnsiFileNames: string;
|
|
||||||
UnicodeFolderName: widestring;
|
|
||||||
UnicodeFileNames: widestring
|
|
||||||
end;
|
|
||||||
POpenFileDialogRec = ^TOpenFileDialogRec;
|
|
||||||
|
|
||||||
// The size of the OPENFILENAME record depends on the windows version
|
// The size of the OPENFILENAME record depends on the windows version
|
||||||
// In the initialization section the correct size is determined.
|
// In the initialization section the correct size is determined.
|
||||||
var
|
var
|
||||||
@ -167,6 +167,93 @@ begin
|
|||||||
Move(PChar(AnsiChars)^, Result^, length(AnsiChars)+1);
|
Move(PChar(AnsiChars)^, Result^, length(AnsiChars)+1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure UpdateFileProperties(OpenFile: LPOPENFILENAME);
|
||||||
|
var
|
||||||
|
DialogRec: POpenFileDialogRec;
|
||||||
|
AOpenDialog: TOpenDialog;
|
||||||
|
|
||||||
|
procedure SetFilesPropertyCustomFiles(AFiles:TStrings);
|
||||||
|
var
|
||||||
|
i, Start: integer;
|
||||||
|
FolderName: string;
|
||||||
|
FileNames: String;
|
||||||
|
begin
|
||||||
|
{$ifdef WindowsUnicodeSupport}
|
||||||
|
if UnicodeEnabledOS then
|
||||||
|
begin
|
||||||
|
FolderName := UTF8Encode(DialogRec^.UnicodeFolderName);
|
||||||
|
FileNames := UTF8Encode(DialogRec^.UnicodeFileNames);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FolderName := AnsiToUtf8(DialogRec^.AnsiFolderName);
|
||||||
|
FileNames := AnsiToUtf8(DialogRec^.AnsiFileNames);
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
|
FolderName:= DialogRec^.AnsiFolderName;
|
||||||
|
FileNames := DialogRec^.AnsiFileNames;
|
||||||
|
{$endif}
|
||||||
|
FolderName := AppendPathDelim(FolderName);
|
||||||
|
if (Length(FileNames) > 0) and (FileNames[1] = '"') then
|
||||||
|
begin
|
||||||
|
Start := 1; // first quote is on pos 1
|
||||||
|
while FileNames[Start] <> #0 do
|
||||||
|
begin
|
||||||
|
i := Start + 1;
|
||||||
|
while FileNames[i] <> '"' do
|
||||||
|
inc(i);
|
||||||
|
AFiles.Add(FolderName + Copy(FileNames, Start + 1, I - Start - 1));
|
||||||
|
start := i+1;
|
||||||
|
while (FileNames[Start] <> #0) and (FileNames[start] <> '"') do
|
||||||
|
inc(Start);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
AFiles.Add(FolderName + FileNames);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SetFilesPropertyForOldStyle(AFiles:TStrings);
|
||||||
|
var
|
||||||
|
SelectedStr: string;
|
||||||
|
FolderName: string;
|
||||||
|
I,Start: integer;
|
||||||
|
begin
|
||||||
|
{$ifdef WindowsUnicodeSupport}
|
||||||
|
if UnicodeEnabledOS then
|
||||||
|
SelectedStr:=UTF8Encode(widestring(PWideChar(OpenFile^.lpStrFile)))
|
||||||
|
else
|
||||||
|
SelectedStr:=AnsiToUtf8(OpenFile^.lpStrFile);
|
||||||
|
{$else}
|
||||||
|
SelectedStr:=OpenFile^.lpStrFile;
|
||||||
|
{$endif}
|
||||||
|
if not (ofAllowMultiSelect in AOpenDialog.Options) then
|
||||||
|
AFiles.Add(SelectedStr)
|
||||||
|
else begin
|
||||||
|
Start:=Pos(' ',SelectedStr);
|
||||||
|
FolderName := copy(SelectedStr,1,start-1);
|
||||||
|
SelectedStr:=SelectedStr+' ';
|
||||||
|
inc(start);
|
||||||
|
for I:= Start to Length(SelectedStr) do
|
||||||
|
if SelectedStr[I] = ' ' then
|
||||||
|
begin
|
||||||
|
AFiles.Add(ExpandFileNameUTF8(FolderName+Copy(SelectedStr,Start,I - Start)));
|
||||||
|
Start:=Succ(I);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
DialogRec := POpenFileDialogRec(OpenFile^.lCustData);
|
||||||
|
AOpenDialog := TOpenDialog(DialogRec^.Dialog);
|
||||||
|
AOpenDialog.Files.Clear;
|
||||||
|
AOpenDialog.FilterIndex := OpenFile^.nFilterIndex;
|
||||||
|
if (ofOldStyleDialog in AOpenDialog.Options) then
|
||||||
|
SetFilesPropertyForOldStyle(AOpenDialog.Files)
|
||||||
|
else
|
||||||
|
SetFilesPropertyCustomFiles(AOpenDialog.Files);
|
||||||
|
AOpenDialog.FileName := AOpenDialog.Files[0];
|
||||||
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
Method: GetOwnerHandle
|
Method: GetOwnerHandle
|
||||||
Params: ADialog - dialog to get 'guiding parent' window handle for
|
Params: ADialog - dialog to get 'guiding parent' window handle for
|
||||||
@ -334,61 +421,44 @@ begin
|
|||||||
begin
|
begin
|
||||||
FolderSize := CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd), nil, 0);
|
FolderSize := CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd), nil, 0);
|
||||||
FilesSize := CommDlg_OpenSave_GetSpecW(GetParent(hwnd), nil, 0);
|
FilesSize := CommDlg_OpenSave_GetSpecW(GetParent(hwnd), nil, 0);
|
||||||
|
SetLength(DialogRec^.UnicodeFolderName, FolderSize-1);
|
||||||
// test if we need to use our own storage
|
CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd),
|
||||||
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
|
PWideChar(DialogRec^.UnicodeFolderName),
|
||||||
(OpenFileName^.lCustData <> 0) then
|
FolderSize);
|
||||||
begin
|
|
||||||
SetLength(DialogRec^.UnicodeFolderName, FolderSize-1);
|
|
||||||
CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd),
|
|
||||||
PWideChar(DialogRec^.UnicodeFolderName),
|
|
||||||
FolderSize);
|
|
||||||
|
|
||||||
if length(DialogRec^.UnicodeFileNames) < FilesSize then
|
SetLength(DialogRec^.UnicodeFileNames, FilesSize - 1);
|
||||||
// allocate twice the size, to prevent much relocations
|
CommDlg_OpenSave_GetSpecW(GetParent(hwnd),
|
||||||
SetLength(DialogRec^.UnicodeFileNames, FilesSize*2);
|
PWideChar(DialogRec^.UnicodeFileNames),
|
||||||
|
FilesSize);
|
||||||
CommDlg_OpenSave_GetSpecW(GetParent(hwnd),
|
|
||||||
PWideChar(DialogRec^.UnicodeFileNames),
|
|
||||||
Length(DialogRec^.UnicodeFileNames));
|
|
||||||
end;
|
|
||||||
end else
|
end else
|
||||||
begin
|
begin
|
||||||
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
|
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
|
||||||
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
|
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
|
||||||
// test if we need to use our own storage
|
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
|
||||||
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
|
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
|
||||||
(OpenFileName^.lCustData <> 0) then
|
PChar(DialogRec^.AnsiFolderName),
|
||||||
begin
|
FolderSize);
|
||||||
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
|
|
||||||
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
|
|
||||||
PChar(DialogRec^.AnsiFolderName), FolderSize);
|
|
||||||
|
|
||||||
if length(DialogRec^.AnsiFileNames) < FilesSize then
|
SetLength(DialogRec^.AnsiFileNames, FilesSize - 1);
|
||||||
// allocate twice the size, to prevent much relocations
|
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
|
||||||
SetLength(DialogRec^.AnsiFileNames, FilesSize*2);
|
PChar(DialogRec^.AnsiFileNames),
|
||||||
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
|
FilesSize);
|
||||||
PChar(DialogRec^.AnsiFileNames), Length(DialogRec^.AnsiFileNames));
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
{$else}
|
{$else}
|
||||||
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
|
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
|
||||||
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
|
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
|
||||||
// test if we need to use our own storage
|
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
|
||||||
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
|
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
|
||||||
(OpenFileName^.lCustData <> 0) then
|
PChar(DialogRec^.AnsiFolderName),
|
||||||
begin
|
FolderSize);
|
||||||
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
|
|
||||||
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
|
|
||||||
PChar(DialogRec^.AnsiFolderName), FolderSize);
|
|
||||||
|
|
||||||
if length(DialogRec^.AnsiFileNames) < FilesSize then
|
SetLength(DialogRec^.AnsiFileNames, FilesSize - 1);
|
||||||
// allocate twice the size, to prevent much relocations
|
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
|
||||||
SetLength(DialogRec^.AnsiFileNames, FilesSize*2);
|
PChar(DialogRec^.AnsiFileNames),
|
||||||
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
|
FilesSize);
|
||||||
PChar(DialogRec^.AnsiFileNames), Length(DialogRec^.AnsiFileNames));
|
|
||||||
end;
|
|
||||||
{$endif}
|
{$endif}
|
||||||
|
UpdateFileProperties(OpenFileName);
|
||||||
|
TOpenDialog(DialogRec^.Dialog).DoSelectionChange;
|
||||||
end;
|
end;
|
||||||
CDN_TYPECHANGE:
|
CDN_TYPECHANGE:
|
||||||
begin
|
begin
|
||||||
@ -538,166 +608,19 @@ end;
|
|||||||
|
|
||||||
procedure ProcessFileDialogResult(AOpenDialog: TOpenDialog; UserResult: WordBool);
|
procedure ProcessFileDialogResult(AOpenDialog: TOpenDialog; UserResult: WordBool);
|
||||||
var
|
var
|
||||||
DialogRec: POpenFileDialogRec;
|
|
||||||
OpenFile: LPOPENFILENAME;
|
OpenFile: LPOPENFILENAME;
|
||||||
|
|
||||||
procedure SetFilesProperty(AFiles:TStrings);
|
|
||||||
var
|
|
||||||
I: integer;
|
|
||||||
pName: PChar;
|
|
||||||
{$ifdef WindowsUnicodeSupport}
|
|
||||||
PWideName: PWideChar;
|
|
||||||
DirName: string;
|
|
||||||
{$endif WindowsUnicodeSupport}
|
|
||||||
begin
|
|
||||||
{$ifdef WindowsUnicodeSupport}
|
|
||||||
if UnicodeEnabledOS then
|
|
||||||
begin
|
|
||||||
PWideName := PWideChar(OpenFile^.lpStrFile);
|
|
||||||
I:=Length(PWideName);
|
|
||||||
if I < OpenFile^.nFileOffset then
|
|
||||||
begin
|
|
||||||
DirName := AppendPathDelim(UTF8Encode(widestring(PWideName)));
|
|
||||||
Inc(PWideName, Succ(I));
|
|
||||||
I:=Length(PWideName);
|
|
||||||
while I > 0 do
|
|
||||||
begin
|
|
||||||
// Don't use expand filename here, it expands directories using
|
|
||||||
// system encoding, not UTF-8
|
|
||||||
AFiles.Add(DirName + Utf8Encode(widestring(PWideName)));
|
|
||||||
Inc(PWideName,Succ(I));
|
|
||||||
I:=Length(PWideName);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
AFiles.Add(Utf8Encode(widestring(PWideName)));
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
pName := OpenFile^.lpStrFile;
|
|
||||||
I:=Length(pName);
|
|
||||||
if I < OpenFile^.nFileOffset then
|
|
||||||
begin
|
|
||||||
DirName := AppendPathDelim(AnsiToUtf8(pName));
|
|
||||||
Inc(pName,Succ(I));
|
|
||||||
I:=Length(pName);
|
|
||||||
while I > 0 do
|
|
||||||
begin
|
|
||||||
AFiles.Add(DirName + AnsiToUtf8(pName));
|
|
||||||
Inc(pName,Succ(I));
|
|
||||||
I:=Length(pName);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
AFiles.Add(StrPas(pName));
|
|
||||||
end;
|
|
||||||
{$else}
|
|
||||||
pName := OpenFile^.lpStrFile;
|
|
||||||
I:=Length(pName);
|
|
||||||
if I < OpenFile^.nFileOffset then
|
|
||||||
begin
|
|
||||||
Inc(pName,Succ(I));
|
|
||||||
I:=Length(pName);
|
|
||||||
while I > 0 do
|
|
||||||
begin
|
|
||||||
AFiles.Add(ExpandFileNameUTF8(StrPas(pName)));
|
|
||||||
Inc(pName,Succ(I));
|
|
||||||
I:=Length(pName);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
AFiles.Add(StrPas(pName));
|
|
||||||
{$endif}
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure SetFilesPropertyCustomFiles(AFiles:TStrings);
|
|
||||||
var
|
|
||||||
i, Start: integer;
|
|
||||||
FolderName: string;
|
|
||||||
FileNames: String;
|
|
||||||
begin
|
|
||||||
{$ifdef WindowsUnicodeSupport}
|
|
||||||
if UnicodeEnabledOS then begin
|
|
||||||
FolderName := UTF8Encode(DialogRec^.UnicodeFolderName);
|
|
||||||
FileNames := UTF8Encode(DialogRec^.UnicodeFileNames);
|
|
||||||
end else begin
|
|
||||||
FolderName := AnsiToUtf8(DialogRec^.AnsiFolderName);
|
|
||||||
FileNames := AnsiToUtf8(DialogRec^.AnsiFileNames);
|
|
||||||
end;
|
|
||||||
{$else}
|
|
||||||
FolderName:= DialogRec^.AnsiFolderName;
|
|
||||||
FileNames := DialogRec^.AnsiFileNames;
|
|
||||||
{$endif}
|
|
||||||
FolderName := AppendPathDelim(FolderName);
|
|
||||||
if (FileNames[1] = '"') then
|
|
||||||
begin
|
|
||||||
Start := 1; // first quote is on pos 1
|
|
||||||
while FileNames[Start] <> #0 do
|
|
||||||
begin
|
|
||||||
i := Start + 1;
|
|
||||||
while FileNames[i] <> '"' do
|
|
||||||
inc(i);
|
|
||||||
AFiles.Add(FolderName + Copy(FileNames, Start + 1, I - Start - 1));
|
|
||||||
start := i+1;
|
|
||||||
while (FileNames[Start] <> #0) and (FileNames[start] <> '"') do
|
|
||||||
inc(Start);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure SetFilesPropertyForOldStyle(AFiles:TStrings);
|
|
||||||
var
|
|
||||||
SelectedStr: string;
|
|
||||||
FolderName: string;
|
|
||||||
I,Start: integer;
|
|
||||||
begin
|
|
||||||
{$ifdef WindowsUnicodeSupport}
|
|
||||||
if UnicodeEnabledOS then
|
|
||||||
SelectedStr:=UTF8Encode(widestring(PWideChar(OpenFile^.lpStrFile)))
|
|
||||||
else
|
|
||||||
SelectedStr:=AnsiToUtf8(OpenFile^.lpStrFile);
|
|
||||||
{$else}
|
|
||||||
SelectedStr:=OpenFile^.lpStrFile;
|
|
||||||
{$endif}
|
|
||||||
if not (ofAllowMultiSelect in AOpenDialog.Options) then
|
|
||||||
AFiles.Add(SelectedStr)
|
|
||||||
else begin
|
|
||||||
Start:=Pos(' ',SelectedStr);
|
|
||||||
FolderName := copy(SelectedStr,1,start-1);
|
|
||||||
SelectedStr:=SelectedStr+' ';
|
|
||||||
inc(start);
|
|
||||||
for I:= Start to Length(SelectedStr) do
|
|
||||||
if SelectedStr[I] = ' ' then
|
|
||||||
begin
|
|
||||||
AFiles.Add(ExpandFileNameUTF8(FolderName+Copy(SelectedStr,Start,I - Start)));
|
|
||||||
Start:=Succ(I);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
BufferTooSmall: boolean;
|
|
||||||
begin
|
begin
|
||||||
OPENFILE := LPOPENFILENAME(AOpenDialog.Handle);
|
OPENFILE := LPOPENFILENAME(AOpenDialog.Handle);
|
||||||
DialogRec := POpenFileDialogRec(OPENFILE^.lCustData);
|
if not UserResult and (CommDlgExtendedError = FNERR_BUFFERTOOSMALL) then
|
||||||
BufferTooSmall := not UserResult and (CommDlgExtendedError=FNERR_BUFFERTOOSMALL);
|
UserResult := True;
|
||||||
if BufferTooSmall then
|
|
||||||
UserResult := true;
|
|
||||||
SetDialogResult(AOpenDialog, UserResult);
|
SetDialogResult(AOpenDialog, UserResult);
|
||||||
|
if UserResult then
|
||||||
AOpenDialog.Files.Clear;
|
UpdateFileProperties(OPENFILE)
|
||||||
if UserResult then
|
else
|
||||||
begin
|
begin
|
||||||
AOpenDialog.FilterIndex := OpenFile^.nFilterIndex;
|
AOpenDialog.Files.Clear;
|
||||||
if (ofOldStyleDialog in AOpenDialog.Options) then
|
|
||||||
SetFilesPropertyForOldStyle(AOpenDialog.Files)
|
|
||||||
else if BufferTooSmall then
|
|
||||||
SetFilesPropertyCustomFiles(AOpenDialog.Files)
|
|
||||||
else
|
|
||||||
SetFilesProperty(AOpenDialog.Files);
|
|
||||||
AOpenDialog.FileName := AOpenDialog.Files[0];
|
|
||||||
end else
|
|
||||||
AOpenDialog.FileName := '';
|
AOpenDialog.FileName := '';
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TWin32WSOpenDialog }
|
{ TWin32WSOpenDialog }
|
||||||
@ -902,7 +825,7 @@ begin
|
|||||||
if length(InitialDir)=0 then
|
if length(InitialDir)=0 then
|
||||||
InitialDir := TSelectDirectoryDialog(ACommonDialog).InitialDir;
|
InitialDir := TSelectDirectoryDialog(ACommonDialog).InitialDir;
|
||||||
if length(InitialDir)>0 then begin
|
if length(InitialDir)>0 then begin
|
||||||
// remove the \ at the end. +
|
// remove the \ at the end.
|
||||||
if Copy(InitialDir,length(InitialDir),1)=PathDelim then
|
if Copy(InitialDir,length(InitialDir),1)=PathDelim then
|
||||||
InitialDir := copy(InitialDir,1, length(InitialDir)-1);
|
InitialDir := copy(InitialDir,1, length(InitialDir)-1);
|
||||||
// if it is a rootdirectory, then the InitialDir must have a \ at the end.
|
// if it is a rootdirectory, then the InitialDir must have a \ at the end.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user