paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-10 23:47:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

win32 interface: complete unicode version of the openfile and savefile dialog (bug #10918)

Browse Source 
git-svn-id: trunk@14661 -
This commit is contained in:
vincents 2008-03-26 21:44:17 +00:00
parent fc6e52e515
commit 8a9d186eba
1 changed files with 158 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,7 +49,7 @@ uses
CommDlg, CommDlg,
{$ENDIF} {$ENDIF}
// lcl // lcl
LCLProc, LCLType, Dialogs, Controls, Graphics, Forms, LCLProc, LCLType, Dialogs, Controls, Graphics, Forms, FileUtil,
// ws // ws
WSDialogs, WSLCLClasses, Win32Extra, Win32Int, InterfaceBase, WSDialogs, WSLCLClasses, Win32Extra, Win32Int, InterfaceBase,
Win32Proc; Win32Proc;
@ -91,8 +91,6 @@ type
private private
protected protected
public public
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override; class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end; end;
@ -137,7 +135,10 @@ implementation
type type
TOpenFileDialogRec = record TOpenFileDialogRec = record
Dialog: TFileDialog; Dialog: TFileDialog;
FileNames: String; AnsiFolderName: string;
AnsiFileNames: string;
UnicodeFolderName: widestring;
UnicodeFileNames: widestring
end; end;
POpenFileDialogRec = ^TOpenFileDialogRec; POpenFileDialogRec = ^TOpenFileDialogRec;
@ -146,6 +147,25 @@ type
var var
OpenFileNameSize: integer = 0; OpenFileNameSize: integer = 0;
// Returns a new PWideChar containing the string UTF8 string s as widechars
function UTF8StringToPWideChar(const s: string) : PWideChar;
begin
// a string of widechars will need at most twice the amount of bytes
// as the corresponding UTF8 string
Result := GetMem(length(s)*2+2);
Utf8ToUnicode(Result,length(s)+1,pchar(s),length(s)+1);
end;
// Returns a new PChar containing the string UTF8 string s as ansichars
function UTF8StringToPAnsiChar(const s: string) : PAnsiChar;
var
AnsiChars: string;
begin
AnsiChars:= Utf8ToAnsi(s);
Result := GetMem(length(AnsiChars)+1);
Move(AnsiChars[1], Result^, length(AnsiChars)+1);
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
@ -248,9 +268,6 @@ end;
retrieving the files is used. retrieving the files is used.
} }
type
TWinFileDialogFunc = function(OpenFile: Windows.LPOPENFILENAME): WINBOOL; stdcall;
function OpenFileDialogCallBack(hWnd: Handle; uMsg: UINT; wParam: WPARAM; function OpenFileDialogCallBack(hWnd: Handle; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): UINT; stdcall; lParam: LPARAM): UINT; stdcall;
@ -278,6 +295,8 @@ var
OpenFileName: Windows.POPENFILENAME; OpenFileName: Windows.POPENFILENAME;
NeededSize: SizeInt; NeededSize: SizeInt;
DialogRec: POpenFileDialogRec; DialogRec: POpenFileDialogRec;
FilesSize: SizeInt;
FolderSize: SizeInt;
begin begin
if uMsg = WM_INITDIALOG then if uMsg = WM_INITDIALOG then
begin begin
@ -308,18 +327,68 @@ begin
// for example 'c:\winnt'#0'file1.txt'#0'file2.txt'#0#0. // for example 'c:\winnt'#0'file1.txt'#0'file2.txt'#0#0.
// GetFolderPath returns upper limit for the path, GetSpec for the files. // GetFolderPath returns upper limit for the path, GetSpec for the files.
// This is not exact because the GetSpec returns the size for // This is not exact because the GetSpec returns the size for
// '"file1.txt" "file2.txt"', so that size will be two bytes per filename // '"file1.txt" "file2.txt"', so that size will be two chars per filename
// more than needed in thlengthe lpStrFile buffer. // more than needed in the lpStrFile buffer.
NeededSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0) + {$ifdef WindowsUnicodeSupport}
CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0); if UnicodeEnabledOS then
// test if we need to use our own storage
if (SizeInt(OpenFileName^.nMaxFile) < NeededSize) and (OpenFileName^.lCustData <> 0) then
begin begin
if length(DialogRec^.FileNames) < NeededSize then FolderSize := CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd), nil, 0);
SetLength(DialogRec^.FileNames, NeededSize*2); FilesSize := CommDlg_OpenSave_GetSpecW(GetParent(hwnd), nil, 0);
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
PChar(DialogRec^.FileNames), Length(DialogRec^.FileNames)); // test if we need to use our own storage
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
(OpenFileName^.lCustData <> 0) then
begin
SetLength(DialogRec^.UnicodeFolderName, FolderSize-1);
CommDlg_OpenSave_GetFolderPathW(GetParent(hwnd),
PWideChar(DialogRec^.UnicodeFolderName),
FolderSize);
if length(DialogRec^.UnicodeFileNames) < FilesSize then
// allocate twice the size, to prevent much relocations
SetLength(DialogRec^.UnicodeFileNames, FilesSize*2);
CommDlg_OpenSave_GetSpecW(GetParent(hwnd),
PWideChar(DialogRec^.UnicodeFileNames),
Length(DialogRec^.UnicodeFileNames));
end; end;
end else
begin
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
// test if we need to use our own storage
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
(OpenFileName^.lCustData <> 0) then
begin
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
PChar(DialogRec^.AnsiFolderName), FolderSize);
if length(DialogRec^.AnsiFileNames) < FilesSize then
// allocate twice the size, to prevent much relocations
SetLength(DialogRec^.AnsiFileNames, FilesSize*2);
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
PChar(DialogRec^.AnsiFileNames), Length(DialogRec^.AnsiFileNames));
end;
end;
{$else}
FolderSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0);
FilesSize := CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
// test if we need to use our own storage
if (SizeInt(OpenFileName^.nMaxFile) < FolderSize + FilesSize) and
(OpenFileName^.lCustData <> 0) then
begin
SetLength(DialogRec^.AnsiFolderName, FolderSize-1);
CommDlg_OpenSave_GetFolderPath(GetParent(hwnd),
PChar(DialogRec^.AnsiFolderName), FolderSize);
if length(DialogRec^.AnsiFileNames) < FilesSize then
// allocate twice the size, to prevent much relocations
SetLength(DialogRec^.AnsiFileNames, FilesSize*2);
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
PChar(DialogRec^.AnsiFileNames), Length(DialogRec^.AnsiFileNames));
end;
{$endif}
end; end;
CDN_TYPECHANGE: CDN_TYPECHANGE:
begin begin
@ -360,7 +429,7 @@ function CreateFileDialogHandle(AOpenDialog: TOpenDialog): THandle;
begin begin
for i := 1 to length(AFilter) do for i := 1 to length(AFilter) do
if AFilter[i] = '|' then AFilter[i]:=#0; if AFilter[i] = '|' then AFilter[i]:=#0;
AFilter:=AFilter + #0#0; AFilter:=AFilter + #0;
end; end;
const const
FileNameBufferLen = 1000; FileNameBufferLen = 1000;
@ -375,19 +444,8 @@ var
FileNameWide: WideString; FileNameWide: WideString;
FileNameWideBuffer: PWideChar; FileNameWideBuffer: PWideChar;
FileNameBufferSize: Integer; FileNameBufferSize: Integer;
FilterBuffer: WideString;
TitleBuffer: WideString;
{$endif WindowsUnicodeSupport} {$endif WindowsUnicodeSupport}
begin begin
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
FileNameWideBuffer := AllocMem(FileNameBufferLen * 2 + 2)
else
FileNameBuffer := AllocMem(FileNameBufferLen + 1);
{$else}
FileNameBuffer := AllocMem(FileNameBufferLen + 1);
{$endif}
FileName := AOpenDialog.FileName; FileName := AOpenDialog.FileName;
InitialDir := AOpenDialog.InitialDir; InitialDir := AOpenDialog.InitialDir;
if (FileName<>'') and (FileName[length(FileName)]=PathDelim) then if (FileName<>'') and (FileName[length(FileName)]=PathDelim) then
@ -401,10 +459,9 @@ begin
{$ifdef WindowsUnicodeSupport} {$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then if UnicodeEnabledOS then
begin begin
FileNameWideBuffer := AllocMem(FileNameBufferLen * 2 + 2);
FileNameWide := UTF8Decode(FileName); FileNameWide := UTF8Decode(FileName);
FillChar(FileNameWideBuffer^, FileNameBufferLen * 2 + 2, #0);
if Length(FileNameWide) > FileNameBufferLen then if Length(FileNameWide) > FileNameBufferLen then
FileNameBufferSize := FileNameBufferLen FileNameBufferSize := FileNameBufferLen
else else
@ -412,9 +469,12 @@ begin
Move(FileNameWide[1], FileNameWideBuffer^, FileNameBufferSize * 2); Move(FileNameWide[1], FileNameWideBuffer^, FileNameBufferSize * 2);
end end
else else begin
FileNameBuffer := AllocMem(FileNameBufferLen + 1);
StrLCopy(FileNameBuffer, PChar(UTF8ToAnsi(FileName)), FileNameBufferLen); StrLCopy(FileNameBuffer, PChar(UTF8ToAnsi(FileName)), FileNameBufferLen);
end;
{$else} {$else}
FileNameBuffer := AllocMem(FileNameBufferLen + 1);
StrLCopy(FileNameBuffer, PChar(FileName), FileNameBufferLen); StrLCopy(FileNameBuffer, PChar(FileName), FileNameBufferLen);
{$endif} {$endif}
@ -424,7 +484,7 @@ begin
ReplacePipe(Filter); ReplacePipe(Filter);
end end
else else
Filter:='All File Types(*.*)'+#0+'*.*'+#0#0; // Default -> avoid empty combobox Filter:='All File Types(*.*)'+#0+'*.*'+#0; // Default -> avoid empty combobox
OpenFile := AllocMem(SizeOf(OpenFileName)); OpenFile := AllocMem(SizeOf(OpenFileName));
with OpenFile^ Do with OpenFile^ Do
@ -439,45 +499,38 @@ begin
if UnicodeEnabledOS then if UnicodeEnabledOS then
begin begin
lpStrFile := PChar(FileNameWideBuffer); lpStrFile := PChar(FileNameWideBuffer);
lpstrFilter:=PChar(UTF8StringToPWideChar(Filter));
FilterBuffer := Utf8Decode(Filter); lpstrTitle:=PChar(UTF8StringToPWideChar(AOpenDialog.Title));
lpStrFilter := GetMem(Length(FilterBuffer) * 2 + 2); lpstrInitialDir:=PChar(UTF8StringToPWideChar(InitialDir));
Move(FilterBuffer[1], lpStrFilter^, Length(FilterBuffer) * 2 + 2);
TitleBuffer := Utf8Decode(AOpenDialog.Title);
{$note AllocMem is used a workaround for a possible bug in Utf8Decode,
it doesn't seem to null terminate the widestring}
lpStrTitle := AllocMem(Length(TitleBuffer) * 2 + 2);
Move(TitleBuffer[1], lpStrTitle^, Length(TitleBuffer) * 2);
end end
else else
begin begin
lpStrFile := FileNameBuffer; lpStrFile := FileNameBuffer;
lpstrFilter:=UTF8StringToPAnsiChar(Filter);
lpStrFilter := StrAlloc(Length(Filter)+1); lpstrTitle:=UTF8StringToPAnsiChar(AOpenDialog.Title);
StrPCopy(lpStrFilter, Utf8ToAnsi(Filter)); lpstrInitialDir:=UTF8StringToPAnsiChar(InitialDir);
lpStrTitle := GetMem(Length(AOpenDialog.Title)+1);
StrPCopy(lpStrTitle, Utf8ToAnsi(AOpenDialog.Title));
end; end;
{$else} {$else}
lpStrFile := FileNameBuffer; lpStrFile := FileNameBuffer;
lpStrFilter := StrAlloc(Length(Filter)+1); lpStrFilter := GetMem(Length(Filter)+1);
StrPCopy(lpStrFilter, Filter); StrPCopy(lpStrFilter, Filter);
lpStrTitle := GetMem(Length(AOpenDialog.Title)+1); lpStrTitle := GetMem(Length(AOpenDialog.Title)+1);
StrPCopy(lpStrTitle, AOpenDialog.Title); StrPCopy(lpStrTitle, AOpenDialog.Title);
lpStrInitialDir := GetMem(Length(InitialDir)+1);
StrPCopy(lpstrInitialDir, InitialDir);
{$endif} {$endif}
lpStrInitialDir := PChar(InitialDir);
nMaxFile := FileNameBufferLen + 1; // Size in TCHARs nMaxFile := FileNameBufferLen + 1; // Size in TCHARs
lpfnHook := @OpenFileDialogCallBack; lpfnHook := @OpenFileDialogCallBack;
Flags := GetFlagsFromOptions(AOpenDialog.Options); Flags := GetFlagsFromOptions(AOpenDialog.Options);
New(DialogRec); New(DialogRec);
// new initializes the filename fields, because ansistring and widestring
// are automated types.
DialogRec^.Dialog := AOpenDialog; DialogRec^.Dialog := AOpenDialog;
DialogRec^.FileNames := '';
lCustData := LParam(DialogRec); lCustData := LParam(DialogRec);
end; end;
Result := THandle(OpenFile); Result := THandle(OpenFile);
@ -494,6 +547,7 @@ var
pName: PChar; pName: PChar;
{$ifdef WindowsUnicodeSupport} {$ifdef WindowsUnicodeSupport}
PWideName: PWideChar; PWideName: PWideChar;
DirName: string;
{$endif WindowsUnicodeSupport} {$endif WindowsUnicodeSupport}
begin begin
{$ifdef WindowsUnicodeSupport} {$ifdef WindowsUnicodeSupport}
@ -503,11 +557,14 @@ var
I:=Length(PWideName); I:=Length(PWideName);
if I < OpenFile^.nFileOffset then if I < OpenFile^.nFileOffset then
begin begin
DirName := AppendPathDelim(UTF8Encode(PWideName));
Inc(PWideName, Succ(I)); Inc(PWideName, Succ(I));
I:=Length(PWideName); I:=Length(PWideName);
while I > 0 do while I > 0 do
begin begin
AFiles.Add(ExpandFileName(Utf8Encode(PWideName))); // Don't use expand filename here, it expands directories using
// system encoding, not UTF-8
AFiles.Add(DirName + Utf8Encode(PWideName));
Inc(PWideName,Succ(I)); Inc(PWideName,Succ(I));
I:=Length(PWideName); I:=Length(PWideName);
end; end;
@ -521,11 +578,12 @@ var
I:=Length(pName); I:=Length(pName);
if I < OpenFile^.nFileOffset then if I < OpenFile^.nFileOffset then
begin begin
DirName := AppendPathDelim(AnsiToUtf8(pName));
Inc(pName,Succ(I)); Inc(pName,Succ(I));
I:=Length(pName); I:=Length(pName);
while I > 0 do while I > 0 do
begin begin
AFiles.Add(ExpandFileName(StrPas(pName))); AFiles.Add(DirName + AnsiToUtf8(pName));
Inc(pName,Succ(I)); Inc(pName,Succ(I));
I:=Length(pName); I:=Length(pName);
end; end;
@ -555,9 +613,22 @@ var
procedure SetFilesPropertyCustomFiles(AFiles:TStrings); procedure SetFilesPropertyCustomFiles(AFiles:TStrings);
var var
i, Start: integer; i, Start: integer;
FolderName: string;
FileNames: String; FileNames: String;
begin begin
FileNames := DialogRec^.FileNames; {$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 if (FileNames[1] = '"') then
begin begin
Start := 1; // first quote is on pos 1 Start := 1; // first quote is on pos 1
@ -566,7 +637,7 @@ var
i := Start + 1; i := Start + 1;
while FileNames[i] <> '"' do while FileNames[i] <> '"' do
inc(i); inc(i);
AFiles.Add(ExpandFileName(Copy(FileNames, Start + 1, I - Start - 1))); AFiles.Add(FolderName + Copy(FileNames, Start + 1, I - Start - 1));
start := i+1; start := i+1;
while (FileNames[Start] <> #0) and (FileNames[start] <> '"') do while (FileNames[Start] <> #0) and (FileNames[start] <> '"') do
inc(Start); inc(Start);
@ -621,56 +692,6 @@ begin
AOpenDialog.FileName := ''; AOpenDialog.FileName := '';
end; end;
{ TWin32WSSaveDialog }
class function TWin32WSSaveDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
Result := CreateFileDialogHandle(TOpenDialog(ACommonDialog));
end;
class procedure TWin32WSSaveDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
var
OpenFile: LPOPENFILENAME;
begin
if ACommonDialog.Handle <> 0 then
begin
OpenFile := LPOPENFILENAME(ACommonDialog.Handle);
if OpenFile^.lCustData <> 0 then
Dispose(POpenFileDialogRec(OPENFILE^.lCustData));
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
FreeMem(OpenFile^.lpStrFilter)
else
StrDispose(OpenFile^.lpStrFilter);
{$else}
StrDispose(OpenFile^.lpStrFilter);
{$endif}
FreeMem(OpenFile^.lpStrFile);
FreeMem(OpenFile^.lpStrTitle);
FreeMem(OpenFile);
end;
end;
class procedure TWin32WSSaveDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
if ACommonDialog.Handle <> 0 then
begin
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileNameW(LPOPENFILENAME(ACommonDialog.Handle)))
else
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileName(LPOPENFILENAME(ACommonDialog.Handle)));
{$else}
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileName(LPOPENFILENAME(ACommonDialog.Handle)));
{$endif}
end;
end;
{ TWin32WSOpenDialog } { TWin32WSOpenDialog }
class function TWin32WSOpenDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; class function TWin32WSOpenDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
@ -688,15 +709,8 @@ begin
if OPENFILE^.lCustData <> 0 then if OPENFILE^.lCustData <> 0 then
Dispose(POpenFileDialogRec(OPENFILE^.lCustData)); Dispose(POpenFileDialogRec(OPENFILE^.lCustData));
{$ifdef WindowsUnicodeSupport} FreeMem(OpenFile^.lpStrFilter);
if UnicodeEnabledOS then FreeMem(OpenFile^.lpstrInitialDir);
FreeMem(OpenFile^.lpStrFilter)
else
StrDispose(OpenFile^.lpStrFilter);
{$else}
StrDispose(OpenFile^.lpStrFilter);
{$endif}
FreeMem(OpenFile^.lpStrFile); FreeMem(OpenFile^.lpStrFile);
FreeMem(OpenFile^.lpStrTitle); FreeMem(OpenFile^.lpStrTitle);
FreeMem(OpenFile); FreeMem(OpenFile);
@ -721,6 +735,26 @@ begin
end; end;
end; end;
{ TWin32WSSaveDialog }
class procedure TWin32WSSaveDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
if ACommonDialog.Handle <> 0 then
begin
{$ifdef WindowsUnicodeSupport}
if UnicodeEnabledOS then
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileNameW(LPOPENFILENAME(ACommonDialog.Handle)))
else
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileName(LPOPENFILENAME(ACommonDialog.Handle)));
{$else}
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileName(LPOPENFILENAME(ACommonDialog.Handle)));
{$endif}
end;
end;
{ TWin32WSFontDialog } { TWin32WSFontDialog }
class function TWin32WSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; class function TWin32WSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;