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

OnTypeChange event implementation for

Browse Source 
TOpenDialog/TSaveDialog for gtk1, gtk2, win32 (reports 619, 8349)

git-svn-id: trunk@10981 -
This commit is contained in:
paul 2007-04-20 12:49:08 +00:00
parent d36a125fd8
commit aae1549400
5 changed files with 237 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/dialogs.pp
View File

@ -100,6 +100,7 @@ type
TFileDialog = class(TCommonDialog)
private
FInternalFilterIndex: Integer;
FDefaultExt: string;
FFileName : String;
FFiles: TStrings;
@ -109,26 +110,32 @@ type
FInitialDir: string;
FOldWorkingDir: string;
FOnHelpClicked: TNotifyEvent;
FOnTypeChange: TNotifyEvent;
procedure SetDefaultExt(const AValue: string);
procedure SetFilterIndex(const AValue: Integer);
protected
function DoExecute: boolean; override;
function GetFilterIndex: Integer; virtual;
procedure SetFileName(const Value: String); virtual;
procedure SetFilter(const Value: String); virtual;
procedure SetHistoryList(const AValue: TStrings); virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure DoTypeChange; virtual;
function Execute: boolean; override;
property Files: TStrings read FFiles;
property HistoryList: TStrings read FHistoryList write SetHistoryList;
procedure IntfFileTypeChanged(NewFilterIndex: Integer);
published
property Title;
property DefaultExt: string read FDefaultExt write SetDefaultExt;
property FileName: String read FFileName write SetFileName;
property Filter: String read FFilter write SetFilter;
property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
property InitialDir: string read FInitialDir write FInitialDir;
property OnHelpClicked: TNotifyEvent read FOnHelpClicked write FOnHelpClicked;
property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange;
end;

35
lcl/include/filedialog.inc
View File

@ -39,6 +39,16 @@ begin
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{ TFileDialog DoOnTypeChange }
{------------------------------------------------------------------------------}
procedure TFileDialog.DoTypeChange;
begin
if Assigned(FOnTypeChange) then
OnTypeChange(Self);
end;
{------------------------------------------------------------------------------}
{ TFileDialog Execute }
{------------------------------------------------------------------------------}
@ -61,6 +71,15 @@ begin
FHistoryList.Assign(AValue);
end;
procedure TFileDialog.IntfFileTypeChanged(NewFilterIndex: Integer);
begin
if FilterIndex <> NewFilterIndex then
begin
FInternalFilterIndex := NewFilterIndex;
DoTypeChange;
end;
end;
{------------------------------------------------------------------------------
procedure TFileDialog.SetDefaultExt(const AValue: string);
------------------------------------------------------------------------------}
@ -71,6 +90,13 @@ begin
FDefaultExt:='.'+FDefaultExt;
end;
procedure TFileDialog.SetFilterIndex(const AValue: Integer);
begin
FFilterIndex := AValue;
if FHandle = 0 then
FInternalFilterIndex := AValue;
end;
{------------------------------------------------------------------------------}
{ TFileDialog DoExecute }
{------------------------------------------------------------------------------}
@ -79,6 +105,14 @@ begin
Result:= inherited DoExecute;
end;
{------------------------------------------------------------------------------
TFileDialog GetFilterIndex
------------------------------------------------------------------------------}
function TFileDialog.GetFilterIndex: Integer;
begin
Result := FInternalFilterIndex;
end;
{------------------------------------------------------------------------------}
{ TFileDialog SetFilter }
{------------------------------------------------------------------------------}
@ -285,3 +319,4 @@ begin
Result:=true;
end;

9
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2128,15 +2128,17 @@ var
theDialog: TCommonDialog;
procedure CheckFilterActivated(FilterWidget: PGtkWidget);
var AFilterEntry: PFileSelFilterEntry;
var
AFilterEntry: PFileSelFilterEntry;
begin
if FilterWidget=nil then exit;
AFilterEntry:=gtk_object_get_data(PGtkObject(FilterWidget),
'LCLIsFilterMenuItem');
if (AFilterEntry<>nil) and (AFilterEntry^.Mask<>nil) then begin
if (AFilterEntry<>nil) and (AFilterEntry^.Mask<>nil) then
begin
PopulateFileAndDirectoryLists(PGtkFileSelection(theDialog.Handle),
AFilterEntry^.Mask);
TOpenDialog(TheDialog).FilterIndex := AFilterEntry^.FilterIndex + 1;
TFileDialog(TheDialog).IntfFileTypeChanged(AFilterEntry^.FilterIndex);
UpdateDetailView(TOpenDialog(theDialog));
end;
end;
@ -3293,3 +3295,4 @@ end;
{$C-}
{$ENDIF}

21
lcl/interfaces/gtk2/gtk2object.inc
View File

@ -1,4 +1,4 @@
{%MainUnit gtk2int.pp}
{%MainUnit gtk2int.pas}
{******************************************************************************
TGtk2WidgetSet
******************************************************************************
@ -127,6 +127,24 @@ begin
Result := False;
end;
procedure Gtk2FileChooserNotifyCB(dialog: PGObject; pspec: PGParamSpec; user_data: gpointer); cdecl;
var
TheDialog: TFileDialog;
GtkFilter: PGtkFileFilter;
GtkFilterList: PGSList;
NewFilterIndex: Integer;
begin
if pspec^.name = 'filter' then
begin // filter changed
theDialog := TFileDialog(user_data);
GtkFilter := gtk_file_chooser_get_filter(dialog);
GtkFilterList := gtk_file_chooser_list_filters(dialog);
NewFilterIndex := g_slist_index(GtkFilterList, GtkFilter);
theDialog.IntfFileTypeChanged(NewFilterIndex);
g_slist_free(GtkFilterList);
end;
end;
procedure Gtk2FileChooserResponseCB(widget: PGtkFileChooser; arg1: gint; data: gpointer); cdecl;
procedure AddFile(List: TStrings; const NewFile: string);
@ -822,6 +840,7 @@ begin
PChar(GTK_STOCK_CANCEL), [GTK_RESPONSE_CANCEL, PChar(Button1), GTK_RESPONSE_OK, nil]);
g_signal_connect(SelWidget, 'response', gtk_signal_func(@Gtk2FileChooserResponseCB), FileDialog);
g_signal_connect(SelWidget, 'notify', gtk_signal_func(@Gtk2FileChooserNotifyCB), FileDialog);
(*gtk 2.8
if FileDialog is TSaveDialog then begin

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

@ -64,6 +64,8 @@ type
protected
public
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end;
{ TWin32WSSaveDialog }
@ -73,6 +75,8 @@ type
protected
public
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end;
{ TWin32WSSelectDirectoryDialog }
@ -113,6 +117,13 @@ type
implementation
type
TOpenFileDialogRec = record
Dialog: TFileDialog;
FileNames: String;
end;
POpenFileDialogRec = ^TOpenFileDialogRec;
// The size of the OPENFILENAME record depends on the windows version
// In the initialization section the correct size is determined.
var
@ -234,46 +245,57 @@ var
OpenFileNotify: LPOFNOTIFY;
OpenFileName: Windows.POPENFILENAME;
NeededSize: SizeInt;
FileNames: pstring;
DialogRec: POpenFileDialogRec;
begin
if uMsg = WM_NOTIFY then begin
if uMsg = WM_NOTIFY then
begin
OpenFileNotify := LPOFNOTIFY(lParam);
if OpenFileNotify^.hdr.code=CDN_SELCHANGE then begin
if OpenFileNotify <> nil then
begin
OpenFileName := OpenFileNotify^.lpOFN;
// NeededSize is the size that the lpStrFile buffer must have.
// the lpstrFile buffer contains the directory and a list of files
// for example 'c:\winnt'#0'file1.txt'#0'file2.txt'#0#0.
// GetFolderPath returns upper limit for the path, GetSpec for the files.
// This is not exact because the GetSpec returns the size for
// '"file1.txt" "file2.txt"', so that size will be two bytes per filename
// more than needed in thlengthe lpStrFile buffer.
NeededSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0) +
CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
// test if we need to use our own storage
if SizeInt(OpenFileName^.nMaxFile)<NeededSize then begin
if OpenFileName^.lCustData=0 then
OpenFileName^.lCustData := Windows.LParam(new(PString));
FileNames := PString(OpenFileName^.lCustData);
if length(FileNames^)<NeededSize then
SetLength(FileNames^, NeededSize*2);
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
PChar(FileNames^), Length(FileNames^));
end;
DialogRec := POpenFileDialogRec(OpenFileName^.lCustData);
end
else
begin
OpenFileName := nil;
DialogRec := nil;
end;
case OpenFileNotify^.hdr.code of
CDN_SELCHANGE:
begin
// NeededSize is the size that the lpStrFile buffer must have.
// the lpstrFile buffer contains the directory and a list of files
// for example 'c:\winnt'#0'file1.txt'#0'file2.txt'#0#0.
// GetFolderPath returns upper limit for the path, GetSpec for the files.
// This is not exact because the GetSpec returns the size for
// '"file1.txt" "file2.txt"', so that size will be two bytes per filename
// more than needed in thlengthe lpStrFile buffer.
NeededSize := CommDlg_OpenSave_GetFolderPath(GetParent(hwnd), nil, 0) +
CommDlg_OpenSave_GetSpec(GetParent(hwnd), nil, 0);
// test if we need to use our own storage
if (SizeInt(OpenFileName^.nMaxFile) < NeededSize) and (OpenFileName^.lCustData <> 0) then
begin
if length(DialogRec^.FileNames) < NeededSize then
SetLength(DialogRec^.FileNames, NeededSize*2);
CommDlg_OpenSave_GetSpec(GetParent(hwnd),
PChar(DialogRec^.FileNames), Length(DialogRec^.FileNames));
end;
end;
CDN_TYPECHANGE:
begin
DialogRec^.Dialog.IntfFileTypeChanged(OpenFileNotify^.lpOFN^.nFilterIndex);
end;
end;
end;
Result:= 0;
end;
procedure ShowFileDialog(AOpenDialog: TOpenDialog; AWinFunc: TWinFileDialogFunc);
var
OpenFile: OPENFILENAME;
UserResult: WINBOOL;
function CreateFileDialogHandle(AOpenDialog: TOpenDialog): THandle;
function GetFlagsFromOptions(Options: TOpenOptions): DWord;
begin
Result := 0;
if ofAllowMultiSelect in Options then
Result := Result or OFN_ALLOWMULTISELECT or OFN_ENABLEHOOK;
Result := OFN_ENABLEHOOK;
if ofAllowMultiSelect in Options then Result := Result or OFN_ALLOWMULTISELECT;
if ofCreatePrompt in Options then Result := Result or OFN_CREATEPROMPT;
if not (ofOldStyleDialog in Options) then Result := Result or OFN_EXPLORER;
if ofExtensionDifferent in Options then Result := Result or OFN_EXTENSIONDIFFERENT;
@ -301,15 +323,72 @@ var
if AFilter[i] = '|' then AFilter[i]:=#0;
AFilter:=AFilter + #0#0;
end;
const
FileNameBufferLen = 1000;
var
DialogRec: POpenFileDialogRec;
OpenFile: LPOPENFILENAME;
Filter: string;
FileName: string;
InitialDir: String;
FileNameBuffer: PChar;
begin
FileNameBuffer := AllocMem(FileNameBufferLen + 1);
FileName := AOpenDialog.FileName;
InitialDir := AOpenDialog.InitialDir;
if (FileName<>'') and (FileName[length(FileName)]=PathDelim) then
begin
// if the filename contains a directory, set the initial directory
// and clear the filename
InitialDir := Copy(FileName,1, Length(FileName)-1);
FileName := '';
end;
StrLCopy(FileNameBuffer, PChar(FileName), FileNameBufferLen);
if AOpenDialog.Filter <> '' then
begin
Filter := AOpenDialog.Filter;
ReplacePipe(Filter);
end
else
Filter:='All File Types(*.*)'+#0+'*.*'+#0#0; // Default -> avoid empty combobox
OpenFile := AllocMem(SizeOf(OpenFileName));
with OpenFile^ Do
begin
lStructSize := OpenFileNameSize;
hWndOwner := GetOwnerHandle(AOpenDialog);
hInstance := System.hInstance;
lpStrFilter := StrAlloc(Length(Filter)+1);
StrPCopy(lpStrFilter, Filter);
nFilterIndex := AOpenDialog.FilterIndex;
lpStrFile := FileNameBuffer;
lpStrTitle := PChar(AOpenDialog.Title);
lpStrInitialDir := PChar(InitialDir);
nMaxFile := FileNameBufferLen + 1; // Size in TCHARs
lpfnHook := @OpenFileDialogCallBack;
Flags := GetFlagsFromOptions(AOpenDialog.Options);
New(DialogRec);
DialogRec^.Dialog := AOpenDialog;
DialogRec^.FileNames := '';
lCustData := LParam(DialogRec);
end;
Result := THandle(OpenFile);
end;
procedure ProcessFileDialogResult(AOpenDialog: TOpenDialog; UserResult: WordBool);
var
DialogRec: POpenFileDialogRec;
OpenFile: LPOPENFILENAME;
procedure SetFilesProperty(AFiles:TStrings);
var
var
I: integer;
pName: PChar;
begin
pName := OpenFile.lpStrFile;
pName := OpenFile^.lpStrFile;
I:=Length(pName);
if I < OpenFile.nFileOffset then begin
if I < OpenFile^.nFileOffset then
begin
Inc(pName,Succ(I));
I:=Length(pName);
while I > 0 do
@ -328,14 +407,16 @@ var
i, Start: integer;
FileNames: String;
begin
FileNames := PString(OpenFile.lCustData)^;
if (FileNames[1] = '"') then begin
FileNames := DialogRec^.FileNames;
if (FileNames[1] = '"') then
begin
Start := 1; // first quote is on pos 1
while FileNames[Start] <> #0 do begin
while FileNames[Start] <> #0 do
begin
i := Start + 1;
while FileNames[i] <> '"' do
inc(i);
AFiles.Add(ExpandFileName(Copy(FileNames,Start+1,I - Start - 1)));
AFiles.Add(ExpandFileName(Copy(FileNames, Start + 1, I - Start - 1)));
start := i+1;
while (FileNames[Start] <> #0) and (FileNames[start] <> '"') do
inc(Start);
@ -348,7 +429,7 @@ var
SelectedStr: string;
I,Start: integer;
begin
SelectedStr:=StrPas(OpenFile.lpStrFile);
SelectedStr:=StrPas(OpenFile^.lpStrFile);
I:=Pos(' ',SelectedStr);
if I = 0 then
AFiles.Add(SelectedStr)
@ -357,55 +438,19 @@ var
SelectedStr:=SelectedStr+' ';
Start:=1;
for I:= 1 to Length(SelectedStr) do
if SelectedStr[I] = ' ' then
if SelectedStr[I] = ' ' then
begin
AFiles.Add(ExpandFileName(Copy(SelectedStr,Start,I - Start)));
Start:=Succ(I);
end;
end;
end;
var
Filter: string;
FileName: string;
InitialDir: String;
FileNameBuffer: array[0..1000] of char;
BufferTooSmall: boolean;
begin
FillChar(FileNameBuffer[0], sizeof(FileNameBuffer), 0);
FileName := AOpenDialog.FileName;
InitialDir := AOpenDialog.InitialDir;
if (FileName<>'') and (FileName[length(FileName)]=PathDelim) then begin
// if the filename contains a directory, set the initial directory
// and clear the filename
InitialDir := Copy(FileName,1, Length(FileName)-1);
FileName := '';
end;
StrLCopy(@FileNameBuffer[0],PChar(Filename),sizeof(FileNameBuffer)-1);
if AOpenDialog.Filter <> '' then
begin
Filter := AOpenDialog.Filter;
ReplacePipe(Filter);
end
else
Filter:='All File Types(*.*)'+#0+'*.*'+#0#0; // Default -> avoid empty combobox
ZeroMemory(@OpenFile, sizeof(OpenFileName));
with OpenFile Do
begin
lStructSize := OpenFileNameSize;
hWndOwner := GetOwnerHandle(AOpenDialog);
hInstance := System.hInstance;
lpStrFilter := StrAlloc(Length(Filter)+1);
StrPCopy(lpStrFilter, Filter);
nFilterIndex := AOpenDialog.FilterIndex;
lpStrFile := FileNameBuffer;
lpStrTitle := PChar(AOpenDialog.Title);
lpStrInitialDir := PChar(InitialDir);
nMaxFile := sizeof(FileNameBuffer);
lpfnHook := @OpenFileDialogCallBack;
Flags := GetFlagsFromOptions(AOpenDialog.Options);
end;
UserResult := AWinFunc(@OpenFile);
OPENFILE := LPOPENFILENAME(AOpenDialog.Handle);
DialogRec := POpenFileDialogRec(OPENFILE^.lCustData);
BufferTooSmall := not UserResult and (CommDlgExtendedError=FNERR_BUFFERTOOSMALL);
if BufferTooSmall then
UserResult := true;
@ -415,7 +460,7 @@ begin
Files.Clear;
if UserResult then
begin
AOpenDialog.FilterIndex := OpenFile.nFilterIndex;
AOpenDialog.FilterIndex := OpenFile^.nFilterIndex;
if (ofOldStyleDialog in Options) then
SetFilesPropertyForOldStyle(Files)
else if BufferTooSmall then
@ -425,10 +470,6 @@ begin
FileName := Files[0];
end else
FileName := '';
if OpenFile.lCustData<>0 then
Dispose(PString(OpenFile.lCustData));
StrDispose(OpenFile.lpStrFilter);
end;
end;
@ -436,16 +477,56 @@ end;
class function TWin32WSSaveDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
ShowFileDialog(TOpenDialog(ACommonDialog), @GetSaveFileName);
Result := 0;
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));
StrDispose(OpenFile^.lpStrFilter);
FreeMem(OpenFile^.lpStrFile);
end;
end;
class procedure TWin32WSSaveDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
if ACommonDialog.Handle <> 0 then
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetSaveFileName(LPOPENFILENAME(ACommonDialog.Handle)));
end;
{ TWin32WSOpenDialog }
class function TWin32WSOpenDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
begin
ShowFileDialog(TOpenDialog(ACommonDialog), @GetOpenFileName);
Result := 0;
Result := CreateFileDialogHandle(TOpenDialog(ACommonDialog));
end;
class procedure TWin32WSOpenDialog.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));
StrDispose(OpenFile^.lpStrFilter);
FreeMem(OpenFile^.lpStrFile);
end;
end;
class procedure TWin32WSOpenDialog.ShowModal(const ACommonDialog: TCommonDialog);
begin
if ACommonDialog.Handle <> 0 then
ProcessFileDialogResult(TOpenDialog(ACommonDialog),
GetOpenFileName(LPOPENFILENAME(ACommonDialog.Handle)));
end;
{ TWin32WSFontDialog }