{ $Id$} { ***************************************************************************** * Gtk2WSDialogs.pp * * ---------------- * * * * * ***************************************************************************** ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } unit Gtk2WSDialogs; {$mode objfpc}{$H+} interface uses // RTL Gtk2, Glib2, gdk2, pango, SysUtils, Classes, // LCL Gtk2Extra, Graphics, Controls, Dialogs, ExtDlgs, LCLType, LazFileUtils, LazUTF8, LCLStrConsts, LCLProc, InterfaceBase, // Widgetset Gtk2Int, Gtk2Globals, Gtk2Def, Gtk2Proc, WSDialogs; type { TGtk2WSCommonDialog } TGtk2WSCommonDialog = class(TWSCommonDialog) private class procedure SetColorDialogColor(ColorSelection: PGtkColorSelectionDialog; Color: TColor); class procedure SetColorDialogPalette(ColorSelection: PGtkColorSelectionDialog; Palette: TStrings); protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; class procedure SetSizes(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; published class function CreateHandle(const {%H-}ACommonDialog: TCommonDialog): THandle; override; class procedure ShowModal(const ACommonDialog: TCommonDialog); override; class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override; end; { TGtk2WSFileDialog } TGtk2WSFileDialog = class(TWSFileDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; end; { TGtk2WSOpenDialog } TGtk2WSOpenDialog = class(TWSOpenDialog) protected class function CreateOpenDialogFilter(OpenDialog: TOpenDialog; SelWidget: PGtkWidget): string; virtual; class procedure CreateOpenDialogHistory(OpenDialog: TOpenDialog; SelWidget: PGtkWidget); virtual; class procedure CreatePreviewDialogControl(PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; class function QueryWSEventCapabilities(const {%H-}ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; end; { TGtk2WSSaveDialog } TGtk2WSSaveDialog = class(TWSSaveDialog) published class function QueryWSEventCapabilities(const {%H-}ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; end; { TGtk2WSSelectDirectoryDialog } TGtk2WSSelectDirectoryDialog = class(TWSSelectDirectoryDialog) published class function QueryWSEventCapabilities(const {%H-}ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; end; { TGtk2WSColorDialog } TGtk2WSColorDialog = class(TWSColorDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; class function QueryWSEventCapabilities(const {%H-}ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; end; { TGtk2WSColorButton } TGtk2WSColorButton = class(TWSColorButton) published end; { TGtk2WSFontDialog } TGtk2WSFontDialog = class(TWSFontDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; class function QueryWSEventCapabilities(const {%H-}ACommonDialog: TCommonDialog): TCDWSEventCapabilities; override; end; // forward declarations procedure UpdateDetailView(OpenDialog: TOpenDialog); implementation {$I gtk2defines.inc} {------------------------------------------------------------------------------- procedure UpdateDetailView Params: OpenDialog: TOpenDialog Result: none Shows some OS dependent information about the current file -------------------------------------------------------------------------------} procedure UpdateDetailView(OpenDialog: TOpenDialog); var FileDetailLabel: PGtkWidget; Filename, OldFilename, Details: String; Widget: PGtkWidget; begin //DebugLn(['UpdateDetailView ']); Widget := {%H-}PGtkWidget(OpenDialog.Handle); FileName := gtk_file_chooser_get_filename(PGtkFileChooser(Widget)); Filename:=SysToUTF8(Filename); OldFilename := OpenDialog.Filename; if Filename = OldFilename then Exit; OpenDialog.Filename := Filename; // tell application, that selection has changed OpenDialog.DoSelectionChange; if (OpenDialog.OnFolderChange <> nil) and (ExtractFilePath(Filename) <> ExtractFilePath(OldFilename)) then OpenDialog.DoFolderChange; // show some information FileDetailLabel := g_object_get_data({%H-}PGObject(OpenDialog.Handle), 'FileDetailLabel'); if FileDetailLabel = nil then Exit; if FileExistsUTF8(Filename) then Details := GetFileDescription(Filename) else Details := Format(rsFileInfoFileNotFound, [Filename]); gtk_label_set_text(PGtkLabel(FileDetailLabel), PChar(Details)); end; // ---------------------- signals ---------------------------------------------- procedure gtkFileChooserSelectionChangedCB({%H-}Chooser: PGtkFileChooser; Data: Pointer); cdecl; var theDialog: TFileDialog; begin theDialog:=TFileDialog(Data); if theDialog is TOpenDialog then UpdateDetailView(TOpenDialog(theDialog)); end; procedure Gtk2FileChooserResponseCB(widget: PGtkFileChooser; arg1: gint; data: gpointer); cdecl; procedure AddFile(List: TStrings; const NewFile: string); var i: Integer; begin for i := 0 to List.Count-1 do if List[i] = NewFile then Exit; List.Add(NewFile); end; function SkipDirectory(const AName: String): Boolean; // gtk2-2.20 have problems. // issue http://bugs.freepascal.org/view.php?id=17278 begin Result := False; if (gtk_major_version = 2) and (gtk_minor_version >= 20) and (gtk_file_chooser_get_action(Widget) = GTK_FILE_CHOOSER_ACTION_OPEN) and DirPathExists(AName) then Result := True; end; var TheDialog: TFileDialog; cFilename: PChar; cFilenames: PGSList; cFilenames1: PGSList; Files: TStringList; aFilename: String; begin //DebugLn(['Gtk2FileChooserResponseCB ']); theDialog := TFileDialog(data); if arg1 = GTK_RESPONSE_CANCEL then begin TheDialog.UserChoice := mrCancel; Exit; end; if theDialog is TOpenDialog then begin if ofAllowMultiSelect in TOpenDialog(theDialog).Options then begin TheDialog.FileName := ''; Files := TStringList(TheDialog.Files); Files.Clear; cFilenames := gtk_file_chooser_get_filenames(widget); if Assigned(cFilenames) then begin cFilenames1 := cFilenames; while Assigned(cFilenames1) do begin cFilename := PChar(cFilenames1^.data); if Assigned(cFilename) then begin aFilename:=SysToUTF8(cFilename); if not SkipDirectory(aFileName) then AddFile(Files, aFilename); g_free(cFilename); end; cFilenames1 := cFilenames1^.next; end; g_slist_free(cFilenames); end; end else TheDialog.Files.Clear; end; cFilename := gtk_file_chooser_get_filename(widget); if Assigned(cFilename) then begin aFilename:=SysToUTF8(cFilename); if SkipDirectory(aFileName) then TheDialog.FileName := '' else TheDialog.FileName := cFilename; g_free(cFilename); if (TheDialog is TOpenDialog) and (not (ofAllowMultiSelect in TOpenDialog(theDialog).Options)) then TheDialog.Files.Add(TheDialog.FileName); end; //?? StoreCommonDialogSetup(theDialog); theDialog.UserChoice := mrOK; end; procedure Gtk2FileChooserNotifyCB(dialog: PGObject; pspec: PGParamSpec; user_data: gpointer); cdecl; var TheDialog: TFileDialog; GtkFilter: PGtkFileFilter; GtkFilterList: PGSList; NewFilterIndex: Integer; begin //DebugLn(['Gtk2FileChooserNotifyCB ']); 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); if (GtkFilter = nil) and (theDialog.Filter <> '') then begin // Either we don't have filter or gtk reset it. // Gtk resets filter if we set both filename and filter but filename // does not fit into filter. Gtk comparision has bug - it compares only by // mime-type, not by pattern. LCL set all filters by pattern. GtkFilter := g_slist_nth_data(GtkFilterList, theDialog.FilterIndex - 1); gtk_file_chooser_set_filter(dialog, GtkFilter); end else begin NewFilterIndex := g_slist_index(GtkFilterList, GtkFilter); theDialog.IntfFileTypeChanged(NewFilterIndex + 1); end; g_slist_free(GtkFilterList); end; end; // ------------------------ Signals -------------------------------------------- {------------------------------------------------------------------------------- function GTKDialogSelectRowCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, whenever a row is selected in a commondialog -------------------------------------------------------------------------------} function gtkDialogSelectRowCB(widget: PGtkWidget; Row, Column: gInt; bevent: pgdkEventButton; data: gPointer): GBoolean; cdecl; var theDialog: TCommonDialog; MenuWidget: PGtkWidget; AFilterEntry: TFileSelFilterEntry; FileSelWidget: PGtkFileSelection; ShiftState: TShiftState; loop : gint; startRow : gint; endRow : gint; begin //debugln('GTKDialogSelectRowCB A '); Result:=CallBackDefaultReturn; if (Data=nil) or (BEvent=nil) or (Column=0) or (Row=0) then ; theDialog:=TCommonDialog(GetLCLObject(Widget)); if (theDialog is TOpenDialog) then begin // only process the callback if there is event data. If there isn't any // event data that means it was called due to a direct function call of the // widget and not an actual mouse click on the widget. FileSelWidget:={%H-}PGtkFileSelection(theDialog.Handle); if (bevent <> nil) and (gdk_event_get_type(bevent) = GDK_2BUTTON_PRESS) and (FileSelWidget^.dir_list = widget) then begin MenuWidget := g_object_get_data(PGObject(FileSelWidget), 'LCLFilterMenu'); if MenuWidget <> nil then begin AFilterEntry := TFileSelFilterEntry(g_object_get_data(PGObject( gtk_menu_get_active(PGtkMenu(MenuWidget))), 'LCLIsFilterMenuItem')); if (AFilterEntry<>nil) and (AFilterEntry.Mask<>nil) then PopulateFileAndDirectoryLists(FileSelWidget,AFilterEntry.Mask); end; end else if (bevent <> nil) and (ofAllowMultiSelect in TOpenDialog(theDialog).Options) and (FileSelWidget^.file_list=widget) then begin // multi selection ShiftState := GTKEventStateToShiftState(BEvent^.State); if ssShift in ShiftState then begin if LastFileSelectRow <> -1 then begin startRow := LastFileSelectRow; endRow := row; if LastFileSelectRow > row then begin startRow := row; endRow := LastFileSelectRow; end; for loop := startRow to endRow do begin gtk_clist_select_row(PGtkCList(widget), loop, column); end; end; end else if not (ssCtrl in ShiftState) then begin gtk_clist_unselect_all(PGtkCList(widget)); gtk_clist_select_row(PGtkCList(widget), row, column); end; LastFileSelectRow := row; end; UpdateDetailView(TOpenDialog(theDialog)); end; end; {------------------------------------------------------------------------------- function gtkDialogHelpclickedCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, whenever the user clicks the help button in a commondialog -------------------------------------------------------------------------------} function gtkDialogHelpclickedCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog : TCommonDialog; begin Result := CallBackDefaultReturn; if (Widget=nil) then ; theDialog := TCommonDialog(data); if theDialog is TOpenDialog then begin if TOpenDialog(theDialog).OnHelpClicked<>nil then TOpenDialog(theDialog).OnHelpClicked(theDialog); end; end; {------------------------------------------------------------------------------- function gtkDialogApplyclickedCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, whenever the user clicks the Apply button in a commondialog -------------------------------------------------------------------------------} function gtkDialogApplyclickedCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog : TCommonDialog; FontName: string; ALogFont: TLogFont; FontDesc: PPangoFontDescription; begin Result := CallBackDefaultReturn; if (Widget=nil) then ; theDialog := TCommonDialog(data); if (theDialog is TFontDialog) and (fdApplyButton in TFontDialog(theDialog).Options) and (Assigned(TFontDialog(theDialog).OnApplyClicked)) then begin FontName := gtk_font_selection_dialog_get_font_name( {%H-}pgtkfontselectiondialog(theDialog.Handle)); if IsFontNameXLogicalFontDesc(FontName) then begin // extract basic font attributes from the font name in XLFD format ALogFont:=XLFDNameToLogFont(FontName); TFontDialog(theDialog).Font.Assign(ALogFont); // set the font name in XLFD format // a font name in XLFD format overrides in the gtk interface all other font // settings. TFontDialog(theDialog).Font.Name := FontName; end else begin FontDesc := pango_font_description_from_string(PChar(FontName)); with TFontDialog(theDialog).Font do begin BeginUpdate; Size := pango_font_description_get_size(FontDesc) div PANGO_SCALE; if pango_font_description_get_weight(FontDesc) >= PANGO_WEIGHT_BOLD then Style := Style + [fsBold] else Style := Style - [fsBold]; if pango_font_description_get_style(FontDesc) > PANGO_STYLE_NORMAL then Style := Style + [fsItalic] else Style := Style - [fsItalic]; Name := pango_font_description_get_family(FontDesc); EndUpdate; end; pango_font_description_free(FontDesc); end; TFontDialog(theDialog).OnApplyClicked(theDialog); end; end; function gtkDialogOKclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; var theDialog : TCommonDialog; Fpointer : Pointer; // colordialog colorsel : PGtkColorSelection; newColor : TGdkColor; // fontdialog FontName : String; ALogFont : TLogFont; // filedialog rowNum : gint; fileInfo : PGChar; fileList : PPgchar; FontDesc: PPangoFontDescription; DirName : string; FileName : string; Files: TStringList; CurFilename: string; //SelectedFont: PGdkFont; function CheckOpenedFilename(var AFilename: string): boolean; begin Result:=true; // maybe file already exists if (ofOverwritePrompt in TOpenDialog(theDialog).Options) and FileExistsUTF8(AFilename) then begin Result := MessageDlg(rsfdOverwriteFile, Format(rsfdFileAlreadyExists,[AFileName]), mtConfirmation,[mbOk,mbCancel],0)=mrOk; if not Result then exit; end; end; procedure AddFile(List: TStrings; const NewFile: string); var i: Integer; begin for i:=0 to List.Count-1 do if List[i]=NewFile then exit; List.Add(NewFile); end; begin Result := True; if (Widget=nil) then ; theDialog := TCommonDialog(data); FPointer := {%H-}Pointer(theDialog.Handle); if theDialog is TFileDialog then begin FileName:=gtk_file_chooser_get_filename(PGtkFileChooser(FPointer)); FileName:=SysToUTF8(Filename); if theDialog is TOpenDialog then begin // check extra options if ofAllowMultiSelect in TOpenDialog(theDialog).Options then begin DirName:=ExtractFilePath(FileName); TFileDialog(data).FileName := ''; Files:=TStringList(TFileDialog(theDialog).Files); Files.Clear; if (Filename<>'') then begin Result:=CheckOpenedFilename(Filename); if not Result then exit; AddFile(Files,FileName); end; fileList := gtk_file_selection_get_selections(PGtkFileSelection(FPointer)); rowNum := 0; While FileList^ <> nil do begin fileInfo := FileList^; CurFilename:=fileInfo; // convert PChar to AnsiString (not typecast) CurFilename:=SysToUTF8(CurFilename); if (CurFilename<>'') and (Files.IndexOf(CurFilename)<0) then begin CurFilename:=DirName+fileInfo; Result:=CheckOpenedFilename(CurFilename); if not Result then exit; Files.Add(CurFilename); end; inc(FileList); inc(rowNum); end; Dec(FileList, rowNum); g_strfreev(fileList); end else begin Result:=CheckOpenedFilename(Filename); if not Result then exit; TFileDialog(data).FileName := Filename; end; end else begin TFileDialog(data).FileName := Filename; end; end else if theDialog is TColorDialog then begin colorSel := PGtkColorSelection(PGtkColorSelectionDialog(FPointer)^.colorsel); gtk_color_selection_get_current_color(colorsel, @newColor); TColorDialog(theDialog).Color := TGDKColorToTColor(newcolor); {$IFDEF VerboseColorDialog} DebugLn('gtkDialogOKclickedCB ',DbgS(TColorDialog(theDialog).Color)); {$ENDIF} end else if theDialog is TFontDialog then begin //DebugLn('Trace:Pressed OK in FontDialog'); FontName := gtk_font_selection_dialog_get_font_name( pgtkfontselectiondialog(FPointer)); //debugln('gtkDialogOKclickedCB FontName=',FontName); //SelectedFont:=gdk_font_load(PChar(FontName)); //debugln('gtkDialogOKclickedCB ',dbgs(SelectedFont)); if IsFontNameXLogicalFontDesc(FontName) then begin // extract basic font attributes from the font name in XLFD format ALogFont:=XLFDNameToLogFont(FontName); TFontDialog(theDialog).Font.Assign(ALogFont); // set the font name in XLFD format // a font name in XLFD format overrides in the gtk interface all other font // settings. TFontDialog(theDialog).Font.Name := FontName; end else begin FontDesc := pango_font_description_from_string(PChar(FontName)); with TFontDialog(theDialog).Font do begin BeginUpdate; Size := pango_font_description_get_size(FontDesc) div PANGO_SCALE; if pango_font_description_get_weight(FontDesc) >= PANGO_WEIGHT_BOLD then Style := Style + [fsBold] else Style := Style - [fsBold]; if pango_font_description_get_style(FontDesc) > PANGO_STYLE_NORMAL then Style := Style + [fsItalic] else Style := Style - [fsItalic]; Name := pango_font_description_get_family(FontDesc); EndUpdate; end; pango_font_description_free(FontDesc); end; //DebugLn('Trace:-----'+TFontDialog(theDialog).Font.Name+'----'); end; StoreCommonDialogSetup(theDialog); theDialog.UserChoice := mrOK; end; {------------------------------------------------------------------------------- function gtkDialogCancelclickedCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, whenever the user clicks the cancel button in a commondialog -------------------------------------------------------------------------------} function gtkDialogCancelclickedCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog : TCommonDialog; begin Result := CallBackDefaultReturn; if (Widget=nil) then ; theDialog := TCommonDialog(data); if theDialog is TFileDialog then begin TFileDialog(data).FileName := ''; end; StoreCommonDialogSetup(theDialog); theDialog.UserChoice := mrCancel; end; {------------------------------------------------------------------------------- function GTKDialogRealizeCB Params: Widget: PGtkWidget; Data: Pointer Result: GBoolean This function is called, whenever a commondialog window is realized -------------------------------------------------------------------------------} function GTKDialogRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl; var LCLComponent: TObject; begin if (Data=nil) then ; gdk_window_set_events(GetControlWindow(Widget), gdk_window_get_events(GetControlWindow(Widget)) or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK); LCLComponent:=GetLCLObject(Widget); if LCLComponent is TCommonDialog then begin {$ifdef DebugCommonDialogEvents} debugln(['GTKDialogRealizeCB calling DoShow']); {$endif} TCommonDialog(LCLComponent).DoShow; end; Result:=true; end; {------------------------------------------------------------------------------- function gtkDialogCloseQueryCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, before a commondialog is destroyed (Only when the user aborts the dialog, not if the dialog closes as the result of a click on one of itÅ› buttons) -------------------------------------------------------------------------------} function gtkDialogCloseQueryCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog : TCommonDialog; CanClose: boolean; begin {$ifdef DebugCommonDialogEvents} debugln(['>>>>gtkDialogCloseQueryCB A']); {$endif} Result := False; // true = do nothing, false = destroy or hide window if (Data=nil) then ; // data is not the commondialog. Get it manually. theDialog := TCommonDialog(GetLCLObject(Widget)); if theDialog=nil then exit; if theDialog.OnCanClose<>nil then begin theDialog.UserChoice := mrCancel; CanClose:=True; {$ifdef DebugCommonDialogEvents} debugln(['gtkDialogCloseQueryCB calling DoCanClose']); {$endif} theDialog.DoCanClose(CanClose); Result:=not CanClose; end; if not Result then begin StoreCommonDialogSetup(theDialog); DestroyCommonDialogAddOns(theDialog); end; {$ifdef DebugCommonDialogEvents} debugln(['gtkDialogCloseQueryCB End']); {$endif} end; {------------------------------------------------------------------------------- function gtkDialogDestroyCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, when a commondialog is destroyed -------------------------------------------------------------------------------} function gtkDialogDestroyCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; begin {$ifdef DebugCommonDialogEvents} debugln(['gtkDialogDestroyCB A']); {$endif} Result := True; if (Widget=nil) then ; TCommonDialog(data).UserChoice := mrCancel; TCommonDialog(data).Close; {$ifdef DebugCommonDialogEvents} debugln(['gtkDialogDestroyCB End']); {$endif} end; {------------------------------------------------------------------------------- function GTKDialogKeyUpDownCB Params: Widget: PGtkWidget; Event : pgdkeventkey; Data: gPointer Result: GBoolean This function is called, whenever a key is pressed or released in a common dialog window -------------------------------------------------------------------------------} function GTKDialogKeyUpDownCB(Widget: PGtkWidget; Event : pgdkeventkey; Data: gPointer) : GBoolean; cdecl; begin Result:=CallBackDefaultReturn; if (Widget=nil) then ; case gdk_event_get_type(Event) of GDK_KEY_RELEASE, GDK_KEY_PRESS: begin if Event^.KeyVal = GDK_KEY_Escape then begin StoreCommonDialogSetup(TCommonDialog(data)); TCommonDialog(data).UserChoice:=mrCancel; end; if (TCommonDialog(data) is TOpenDialog) then begin UpdateDetailView(TOpenDialog(data)); end; end; end; end; {------------------------------------------------------------------------------- function GTKDialogFocusInCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, when a widget of a commondialog gets focus -------------------------------------------------------------------------------} function GTKDialogFocusInCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog: TCommonDialog; begin //debugln('GTKDialogFocusInCB A '); Result:=CallBackDefaultReturn; if (Data=nil) then ; theDialog:=TCommonDialog(GetLCLObject(Widget)); if (theDialog is TOpenDialog) then begin UpdateDetailView(TOpenDialog(theDialog)); end; end; {------------------------------------------------------------------------------- function GTKDialogMenuActivateCB Params: widget: PGtkWidget; data: gPointer Result: GBoolean This function is called, whenever a menu of a commondialog is activated -------------------------------------------------------------------------------} function GTKDialogMenuActivateCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog: TCommonDialog; procedure CheckFilterActivated(FilterWidget: PGtkWidget); var AFilterEntry: TFileSelFilterEntry; begin if FilterWidget=nil then exit; AFilterEntry:=TFileSelFilterEntry(g_object_get_data(PGObject(FilterWidget), 'LCLIsFilterMenuItem')); if (AFilterEntry<>nil) and (AFilterEntry.Mask<>nil) then begin PopulateFileAndDirectoryLists({%H-}PGtkFileSelection(theDialog.Handle), AFilterEntry.Mask); TFileDialog(TheDialog).IntfFileTypeChanged(AFilterEntry.FilterIndex + 1); UpdateDetailView(TOpenDialog(theDialog)); end; end; var AHistoryEntry: PFileSelHistoryEntry; aSysFilename: String; begin Result:=false; if (Data=nil) then ; theDialog:=TCommonDialog(GetNearestLCLObject(Widget)); if (theDialog is TOpenDialog) then begin // check if history activated AHistoryEntry:=g_object_get_data(PGObject(Widget), 'LCLIsHistoryMenuItem'); if (AHistoryEntry<>nil) and (AHistoryEntry^.Filename<>nil) then begin // user has choosen a history file // -> select it in the filedialog aSysFilename:=UTF8ToSys(AHistoryEntry^.Filename); gtk_file_chooser_set_current_folder({%H-}PGtkFileChooser(theDialog.Handle), Pgchar(aSysFilename)); UpdateDetailView(TOpenDialog(theDialog)); end; end; end; { TGtk2WSSelectDirectoryDialog } class function TGtk2WSSelectDirectoryDialog.QueryWSEventCapabilities( const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; begin Result := [cdecWSPerformsDoShow]; end; { TGtk2WSSaveDialog } class function TGtk2WSSaveDialog.QueryWSEventCapabilities( const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; begin Result := [cdecWSPerformsDoShow]; end; // ---------------------- END OF signals --------------------------------------- { TGtk2WSOpenDialog } class function TGtk2WSOpenDialog.CreateOpenDialogFilter( OpenDialog: TOpenDialog; SelWidget: PGtkWidget): string; var ListOfFileSelFilterEntry: TFPList; i, j, k: integer; GtkFilter, GtkSelFilter: PGtkFileFilter; MaskList: TStringList; FilterEntry: TFileSelFilterEntry; FilterIndex: Integer; aMask: String; begin FilterIndex := OpenDialog.FilterIndex; ExtractFilterList(OpenDialog.Filter, ListOfFileSelFilterEntry, false); GtkSelFilter := nil; if ListOfFileSelFilterEntry.Count > 0 then begin j := 1; MaskList := TStringList.Create; MaskList.Delimiter := ';'; for i := 0 to ListOfFileSelFilterEntry.Count-1 do begin GtkFilter := gtk_file_filter_new(); FilterEntry := TFileSelFilterEntry(ListOfFileSelFilterEntry[i]); MaskList.DelimitedText := FilterEntry.Mask; for k := 0 to MaskList.Count - 1 do begin aMask:=UTF8ToSys(MaskList.Strings[k]); gtk_file_filter_add_pattern(GtkFilter, PChar(aMask)); end; gtk_file_filter_set_name(GtkFilter, FilterEntry.Description); gtk_file_chooser_add_filter(SelWidget, GtkFilter); if j = FilterIndex then GtkSelFilter := GtkFilter; Inc(j); GtkFilter := nil; end; MaskList.Free; end; FreeListOfFileSelFilterEntry(ListOfFileSelFilterEntry); //g_object_set_data(PGObject(SelWidget), 'LCLFilterList', ListOfFileSelFilterEntry); if GtkSelFilter <> nil then gtk_file_chooser_set_filter(SelWidget, GtkSelFilter); Result := 'hm'; { Don't use '' as null return as this is used for *.* } end; class procedure TGtk2WSOpenDialog.CreateOpenDialogHistory( OpenDialog: TOpenDialog; SelWidget: PGtkWidget); var HistoryList: TFPList; // list of THistoryListEntry AHistoryEntry: PFileSelHistoryEntry; i: integer; s: string; HBox, LabelWidget, HistoryPullDownWidget, MenuWidget, MenuItemWidget: PGtkWidget; begin if OpenDialog.HistoryList.Count>0 then begin // create the HistoryList where the current state of the history is stored HistoryList:=TFPList.Create; for i:=0 to OpenDialog.HistoryList.Count-1 do begin s:=OpenDialog.HistoryList[i]; if s<>'' then begin New(AHistoryEntry); HistoryList.Add(AHistoryEntry); AHistoryEntry^.Filename := StrAlloc(length(s)+1); StrPCopy(AHistoryEntry^.Filename, s); AHistoryEntry^.MenuItem:=nil; end; end; // create a HBox so that the history is left justified HBox:=gtk_hbox_new(false,0); g_object_set_data(PGObject(SelWidget), 'LCLHistoryHBox', HBox); gtk_file_chooser_set_extra_widget(PGtkDialog(SelWidget),HBox); // create the label 'History:' s:=rsgtkHistory; LabelWidget:=gtk_label_new(PChar(s)); gtk_box_pack_start(GTK_BOX(HBox),LabelWidget,false,false,5); gtk_widget_show(LabelWidget); // create the pull down HistoryPullDownWidget:=gtk_option_menu_new; g_object_set_data(PGObject(SelWidget), 'LCLHistoryPullDown', HistoryPullDownWidget); gtk_box_pack_start(GTK_BOX(HBox),HistoryPullDownWidget,false,false,5); gtk_widget_show(HistoryPullDownWidget); gtk_widget_show_all(HBox); // create the menu (the content of the pull down) MenuWidget:=gtk_menu_new; SetLCLObject(MenuWidget,OpenDialog); for i:=0 to HistoryList.Count-1 do begin // create the menu items in the history menu MenuItemWidget:=gtk_menu_item_new_with_label( PFileSelHistoryEntry(HistoryList[i])^.Filename); // connect the new MenuItem to the HistoryList entry g_object_set_data(PGObject(MenuItemWidget), 'LCLIsHistoryMenuItem', HistoryList[i]); // add activation signal and add to menu g_signal_connect(GTK_OBJECT(MenuItemWidget), 'activate', gtk_signal_func(@GTKDialogMenuActivateCB), OpenDialog); gtk_menu_append(MenuWidget, MenuItemWidget); gtk_widget_show(MenuItemWidget); end; gtk_widget_show(MenuWidget); gtk_option_menu_set_menu(GTK_OPTION_MENU(HistoryPullDownWidget), MenuWidget); end else begin MenuWidget:=nil; HistoryList:=nil end; g_object_set_data(PGObject(SelWidget), 'LCLHistoryMenu', MenuWidget); g_object_set_data(PGObject(SelWidget), 'LCLHistoryList', HistoryList); end; class procedure TGtk2WSOpenDialog.CreatePreviewDialogControl( PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget); var PreviewWidget: PGtkWidget; AControl: TPreviewFileControl; Win, SubWin: TWinControl; FileChooser: PGtkFileChooser; begin AControl := PreviewDialog.PreviewFileControl; if AControl = nil then Exit; FileChooser := PGtkFileChooser(SelWidget); PreviewWidget := {%H-}PGtkWidget(AControl.Handle); g_object_set_data(PGObject(PreviewWidget),'LCLPreviewFixed', PreviewWidget); gtk_widget_set_size_request(PreviewWidget,AControl.Width,AControl.Height); // manually resize the preview objects, it seems, automatic resize is not // working when parent of LCL control is not a LCL control. if (AControl.ControlCount>0) and (AControl.Controls[0] is TWinControl) then begin Win := TWinControl(AControl.Controls[0]); // groupbox SubWin := TWinControl(Win.Controls[0]); // image gtk_widget_set_size_request({%H-}PGtkWidget(Win.Handle), AControl.Width, AControl.Height); SubWin.width := AControl.Width-4; // skip borders SubWin.height := AControl.Height-15; // end; gtk_file_chooser_set_preview_widget(FileChooser, PreviewWidget); end; { Adds some functionality to a gtk file selection dialog. - multiselection - range selection - close on escape - file information - history pulldown - filter pulldown - preview control requires: gtk+ 2.6 } class function TGtk2WSOpenDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; var FileSelWidget: PGtkFileChooser; OpenDialog: TOpenDialog absolute ACommonDialog; HelpButton: PGtkWidget; InitialFilename: String; aSysFilename: String; //FrameWidget: PGtkWidget; //HBox: PGtkWidget; //FileDetailLabel: PGtkWidget; begin Result := TGtk2WSFileDialog.CreateHandle(ACommonDialog); FileSelWidget := {%H-}PGtkFileChooser(Result); if OpenDialog.InheritsFrom(TSaveDialog) then begin if OpenDialog.InitialDir <> '' then begin aSysFilename:=UTF8ToSys(OpenDialog.InitialDir); gtk_file_chooser_set_current_folder(FileSelWidget, Pgchar(aSysFilename)); end; end; // Help button if (ofShowHelp in OpenDialog.Options) then begin HelpButton := gtk_dialog_add_button(FileSelWidget, GTK_STOCK_HELP, GTK_RESPONSE_NONE); g_signal_connect(PGtkObject(HelpButton), 'clicked', gtk_signal_func(@gtkDialogHelpclickedCB), OpenDialog); end; if ofAllowMultiSelect in OpenDialog.Options then gtk_file_chooser_set_select_multiple(FileSelWidget, gboolean(gtrue)); // History List - a frame with an option menu CreateOpenDialogHistory(OpenDialog, FileSelWidget); // Filter CreateOpenDialogFilter(OpenDialog, FileSelWidget); // connect change event g_signal_connect(PGtkObject(FileSelWidget), 'selection-changed', gtk_signal_func(@gtkFileChooserSelectionChangedCB), OpenDialog); // Sets the dialog options // ofForceShowHidden if (ofForceShowHidden in OpenDialog.Options) then gtk_file_chooser_set_show_hidden(FileSelWidget, True); (* TODO // Details - a frame with a label if (ofViewDetail in OpenDialog.Options) then begin // create the frame around the information FrameWidget:=gtk_frame_new(PChar(rsFileInformation)); //gtk_box_pack_start(GTK_BOX(FileSelWidget^.main_vbox), // FrameWidget,false,false,0); gtk_box_pack_start(GTK_BOX(gtk_file_chooser_get_extra_widget( PGtkFileChooser(SelWidget))), FrameWidget,false,false,0); gtk_widget_show(FrameWidget); // create a HBox, so that the information is left justified HBox:=gtk_hbox_new(false,0); gtk_container_add(GTK_CONTAINER(FrameWidget), HBox); // create the label for the file information FileDetailLabel:=gtk_label_new(PChar(rsDefaultFileInfoValue)); gtk_box_pack_start(GTK_BOX(HBox),FileDetailLabel,false,false,5); gtk_widget_show_all(HBox); end else FileDetailLabel:=nil; g_object_set_data(PGObject(SelWidget), 'FileDetailLabel', FileDetailLabel); *) // preview if (OpenDialog is TPreviewFileDialog) then CreatePreviewDialogControl(TPreviewFileDialog(OpenDialog), PGtkWidget(FileSelWidget)); // set initial filename (gtk expects an absolute filename) InitialFilename := TrimFilename(OpenDialog.FileName); if InitialFilename <> '' then begin if not FilenameIsAbsolute(InitialFilename) and (OpenDialog.InitialDir <> '') then InitialFilename := TrimFilename(OpenDialog.InitialDir + PathDelim + InitialFilename); if not FilenameIsAbsolute(InitialFilename) then InitialFilename := CleanAndExpandFilename(InitialFilename); aSysFilename:=UTF8ToSys(InitialFilename); gtk_file_chooser_set_filename(FileSelWidget, PChar(aSysFilename)); end; //if InitialFilter <> 'none' then // PopulateFileAndDirectoryLists(FileSelWidget, InitialFilter); end; class function TGtk2WSOpenDialog.QueryWSEventCapabilities( const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; begin Result := [cdecWSPerformsDoShow]; end; { TGtk2WSFileDialog } class procedure TGtk2WSFileDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); begin TGtk2WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); g_signal_connect(AGtkWidget, 'response', gtk_signal_func(@Gtk2FileChooserResponseCB), AWidgetInfo^.LCLObject); g_signal_connect(AGtkWidget, 'notify', gtk_signal_func(@Gtk2FileChooserNotifyCB), AWidgetInfo^.LCLObject); end; { Creates a new TFile/Open/SaveDialog requires: gtk+ 2.6 } class function TGtk2WSFileDialog.CreateHandle(const ACommonDialog: TCommonDialog ): THandle; var FileDialog: TFileDialog absolute ACommonDialog; Action: TGtkFileChooserAction; Button1: String; Widget: PGtkWidget; WidgetInfo: PWidgetInfo; aSysFilename: String; begin // Defines an action for the dialog and creates it Action := GTK_FILE_CHOOSER_ACTION_OPEN; Button1 := GTK_STOCK_OPEN; if (FileDialog is TSaveDialog) or (FileDialog is TSavePictureDialog) then begin Action := GTK_FILE_CHOOSER_ACTION_SAVE; Button1 := GTK_STOCK_SAVE; end else if FileDialog is TSelectDirectoryDialog then begin Action := GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER; Button1 := GTK_STOCK_OPEN; end; Widget := gtk_file_chooser_dialog_new(PChar(FileDialog.Title), nil, Action, PChar(GTK_STOCK_CANCEL), [GTK_RESPONSE_CANCEL, PChar(Button1), GTK_RESPONSE_OK, nil]); {$ifdef GTK_2_8} if FileDialog is TSaveDialog then begin gtk_file_chooser_set_do_overwrite_confirmation(Widget, ofOverwritePrompt in TOpenDialog(FileDialog).Options); end; {$endif} if FileDialog.InitialDir <> '' then begin aSysFilename:=UTF8ToSys(FileDialog.InitialDir); gtk_file_chooser_set_current_folder(Widget, Pgchar(aSysFilename)); end; if gtk_file_chooser_get_action(Widget) in [GTK_FILE_CHOOSER_ACTION_SAVE, GTK_FILE_CHOOSER_ACTION_CREATE_FOLDER] then gtk_file_chooser_set_current_name(Widget, Pgchar(FileDialog.FileName)); Result := THandle({%H-}PtrUInt(Widget)); WidgetInfo := CreateWidgetInfo(Widget); WidgetInfo^.LCLObject := ACommonDialog; TGtk2WSCommonDialog.SetSizes(Widget, WidgetInfo); SetCallbacks(Widget, WidgetInfo); end; { TGtk2WSCommonDialog } {------------------------------------------------------------------------------ Method: SetColorDialogColor Params: ColorSelection : a gtk color selection dialog; Color : the color to select Returns: nothing Set the color of the color selection dialog ------------------------------------------------------------------------------} class procedure TGtk2WSCommonDialog.SetColorDialogColor(ColorSelection: PGtkColorSelectionDialog; Color: TColor); var SelectionColor: TGDKColor; colorSel: PGtkColorSelection; begin Color := TColor(ColorToRGB(Color)); SelectionColor := TColortoTGDKColor(Color); colorSel := PGtkColorSelection(ColorSelection^.colorsel); gtk_color_selection_set_current_color(colorSel, @SelectionColor); gtk_color_selection_set_previous_color(colorSel, @SelectionColor); end; class procedure TGtk2WSCommonDialog.SetColorDialogPalette( ColorSelection: PGtkColorSelectionDialog; Palette: TStrings); const PaletteSetting = 'gtk-color-palette'; var colorSel: PGtkColorSelection; settings: PGtkSettings; new_palette: Pgchar; colors: PGdkColor; colors_len: gint; procedure FillCustomColors; var i, AIndex: integer; AColor: TColor; begin for i := 0 to Palette.Count - 1 do if ExtractColorIndexAndColor(Palette, i, AIndex, AColor) then if AIndex < colors_len then colors[AIndex] := TColortoTGDKColor(AColor); end; begin colorSel := PGtkColorSelection(ColorSelection^.colorsel); // show palette gtk_color_selection_set_has_palette(colorSel, True); // replace palette. it is stored in 'gtk-color-palette' settings. // 1. get original palette => we will know colors and replace only part of it settings := gtk_widget_get_settings(PGtkWidget(colorSel)); new_palette := nil; g_object_get(settings, PaletteSetting, [@new_palette, nil]); colors:=nil; gtk_color_selection_palette_from_string(new_palette, colors, @colors_len); g_free(new_palette); // 2. fill original palette with our custom colors FillCustomColors; // 3. set new palette back to settings new_palette := gtk_color_selection_palette_to_string(colors, colors_len); g_free(colors); gtk_settings_set_string_property(settings, PaletteSetting, new_palette, 'gtk_color_selection_palette_to_string'); g_free(new_palette); end; class procedure TGtk2WSCommonDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); begin g_signal_connect(PGtkObject(AGtkWidget), 'destroy', gtk_Signal_Func(@gtkDialogDestroyCB), AWidgetInfo^.LCLObject); g_signal_connect(PGtkObject(AGtkWidget), 'delete-event', gtk_Signal_Func(@gtkDialogCloseQueryCB), AWidgetInfo^.LCLObject); g_signal_connect(PGtkObject(AGtkWidget), 'key-press-event', gtk_Signal_Func(@GTKDialogKeyUpDownCB), AWidgetInfo^.LCLObject); g_signal_connect(PGtkObject(AGtkWidget), 'key-release-event', gtk_Signal_Func(@GTKDialogKeyUpDownCB), AWidgetInfo^.LCLObject); g_signal_connect(PGtkObject(AGtkWidget), 'realize', gtk_Signal_Func(@GTKDialogRealizeCB), AWidgetInfo^.LCLObject); end; class procedure TGtk2WSCommonDialog.SetSizes(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); var NewWidth, NewHeight: integer; begin // set default size NewWidth := TCommonDialog(AWidgetInfo^.LCLObject).Width; if NewWidth <= 0 then NewWidth := -2; // -2 = let the window manager decide NewHeight := TCommonDialog(AWidgetInfo^.LCLObject).Height; if NewHeight<=0 then NewHeight := -2; // -2 = let the window manager decide if (NewWidth > 0) or (NewHeight > 0) then gtk_window_set_default_size(PGtkWindow(AGtkWidget), NewWidth, NewHeight); end; class function TGtk2WSCommonDialog.CreateHandle( const ACommonDialog: TCommonDialog): THandle; begin Result := 0; end; class procedure TGtk2WSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog); var GtkWindow: PGtkWindow; begin ReleaseMouseCapture; GtkWindow:={%H-}PGtkWindow(ACommonDialog.Handle); gtk_window_set_title(GtkWindow,PChar(ACommonDialog.Title)); if ACommonDialog is TColorDialog then begin SetColorDialogColor(PGtkColorSelectionDialog(GtkWindow), TColorDialog(ACommonDialog).Color); SetColorDialogPalette(PGtkColorSelectionDialog(GtkWindow), TColorDialog(ACommonDialog).CustomColors); end; gtk_window_set_position(GtkWindow, GTK_WIN_POS_CENTER); GtkWindowShowModal(nil, GtkWindow); end; class procedure TGtk2WSCommonDialog.DestroyHandle( const ACommonDialog: TCommonDialog); begin { TODO: cleanup } TGtk2WidgetSet(WidgetSet).DestroyLCLComponent(ACommonDialog); end; { TGtk2WSColorDialog } class procedure TGtk2WSColorDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); begin TGtk2WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); g_signal_connect(PGtkObject(PGtkColorSelectionDialog(AGtkWidget)^.ok_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), AWidgetInfo^.LCLObject); g_signal_connect(PGtkObject(PGtkColorSelectionDialog(AGtkWidget)^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), AWidgetInfo^.LCLObject); end; class function TGtk2WSColorDialog.CreateHandle( const ACommonDialog: TCommonDialog): THandle; var Widget: PGtkWidget; WidgetInfo: PWidgetInfo; begin Widget := gtk_color_selection_dialog_new(PChar(ACommonDialog.Title)); Result := THandle({%H-}PtrUInt(Widget)); WidgetInfo := CreateWidgetInfo(Widget); WidgetInfo^.LCLObject := ACommonDialog; TGtk2WSCommonDialog.SetSizes(Widget, WidgetInfo); SetCallbacks(Widget, WidgetInfo); end; class function TGtk2WSColorDialog.QueryWSEventCapabilities( const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; begin Result := [cdecWSPerformsDoShow]; end; { TGtk2WSFontDialog } class procedure TGtk2WSFontDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); begin TGtk2WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); // connect Ok, Cancel and Apply Button g_signal_connect( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.ok_button), 'clicked', gtk_signal_func(@gtkDialogOKclickedCB), AWidgetInfo^.LCLObject); g_signal_connect( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.cancel_button), 'clicked', gtk_signal_func(@gtkDialogCancelclickedCB), AWidgetInfo^.LCLObject); g_signal_connect( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.apply_button), 'clicked', gtk_signal_func(@gtkDialogApplyclickedCB), AWidgetInfo^.LCLObject); end; class function TGtk2WSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; var FontDesc: PPangoFontDescription; TmpStr: pChar; Widget: PGtkWidget; WidgetInfo: PWidgetInfo; FontDialog: TFontDialog absolute ACommonDialog; begin Widget := gtk_font_selection_dialog_new(PChar(ACommonDialog.Title)); if fdApplyButton in FontDialog.Options then gtk_widget_show(PGtkFontSelectionDialog(Widget)^.apply_button); // set preview text if FontDialog.PreviewText <> '' then gtk_font_selection_dialog_set_preview_text(PGtkFontSelectionDialog(Widget), PChar(FontDialog.PreviewText)); // set font name in XLFD format if IsFontNameXLogicalFontDesc(FontDialog.Font.Name) then gtk_font_selection_dialog_set_font_name(PGtkFontSelectionDialog(Widget), PChar(FontDialog.Font.Name)) else begin FontDesc := pango_font_description_new; with FontDialog.Font do begin pango_font_description_set_size(FontDesc, Size * PANGO_SCALE); if fsBold in Style then pango_font_description_set_weight(FontDesc, PANGO_WEIGHT_BOLD) else pango_font_description_set_weight(FontDesc, PANGO_WEIGHT_NORMAL); if fsItalic in Style then pango_font_description_set_style(FontDesc, PANGO_STYLE_ITALIC) else pango_font_description_set_style(FontDesc, PANGO_STYLE_NORMAL); pango_font_description_set_family(FontDesc, PChar(Name)); end; TmpStr := pango_font_description_to_string(FontDesc); gtk_font_selection_dialog_set_font_name(PGtkFontSelectionDialog(Widget), TmpStr); g_free(TmpStr); pango_font_description_free(FontDesc); end; { This functionality does not seem to be available in GTK2 } // Honor selected TFontDialogOption flags Result := THandle({%H-}PtrUInt(Widget)); WidgetInfo := CreateWidgetInfo(Widget); WidgetInfo^.LCLObject := ACommonDialog; TGtk2WSCommonDialog.SetSizes(Widget, WidgetInfo); SetCallbacks(Widget, WidgetInfo); end; class function TGtk2WSFontDialog.QueryWSEventCapabilities( const ACommonDialog: TCommonDialog): TCDWSEventCapabilities; begin Result := [cdecWSPerformsDoShow]; end; end.