{ ***************************************************************************** * Gtk3WSDialogs.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 Gtk3WSDialogs; {$I gtk3defines.inc} {$mode objfpc}{$H+} interface uses // Bindings LazGtk3, LazGlib2, LazGdk3, LazGObject2, LazPango1, // RTL, FCL and LCL SysUtils, Classes, Graphics, Controls, Dialogs, ExtDlgs, LCLType, LazFileUtils, LCLStrConsts, LCLProc, InterfaceBase, // Widgetset gtk3int, gtk3widgets, WSDialogs; type { TGtk3WSCommonDialog } TGtk3WSCommonDialog = 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: TGtk3Dialog); virtual; class procedure SetSizes(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; class procedure ShowModal(const ACommonDialog: TCommonDialog); override; class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override; end; { TGtk3WSFileDialog } TGtk3WSFileDialog = class(TWSFileDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; end; { TGtk3WSOpenDialog } TGtk3WSOpenDialog = 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; end; { TGtk3WSSaveDialog } TGtk3WSSaveDialog = class(TWSSaveDialog) published end; { TGtk3WSSelectDirectoryDialog } TGtk3WSSelectDirectoryDialog = class(TWSSelectDirectoryDialog) published end; { TGtk3WSColorDialog } TGtk3WSColorDialog = class(TWSColorDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; end; { TGtk3WSColorButton } TGtk3WSColorButton = class(TWSColorButton) published end; { TGtk3WSFontDialog } TGtk3WSFontDialog = class(TWSFontDialog) protected class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); virtual; published class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; end; // forward declarations procedure UpdateDetailView(OpenDialog: TOpenDialog); implementation uses gtk3procs; { file dialog } type PFileSelHistoryEntry = ^TFileSelHistoryEntry; TFileSelHistoryEntry = record Filename: PChar; MenuItem: PGtkWidget; end; { TFileSelFilterEntry } TFileSelFilterEntry = class public Description: String; Mask: String; FilterIndex: integer; MenuItem: PGtkWidget; constructor Create(const ADescription, AMask: string); destructor Destroy; override; end; constructor TFileSelFilterEntry.Create(const ADescription, AMask: string); begin Description := ADescription; Mask := AMask; FilterIndex := 1; MenuItem := nil; end; destructor TFileSelFilterEntry.Destroy; begin inherited Destroy; end; {------------------------------------------------------------------------------ Function: ExtractFilterList Params: const Filter: string; var FilterIndex: integer; var ListOfPFileSelFilterEntry: TStringList Returns: - Converts a Delphi file filter of the form 'description1|mask1|description2|mask2|...' into a TFPList of PFileSelFilterEntry(s). Multi masks: - multi masks like '*.pas;*.pp' are converted into multiple entries. - if the masks are found in the description they are adjusted - if the mask is not included in the description it will be concatenated For example: 'Pascal files (*.pas;*.pp)|*.pas;*.lpr;*.pp; is converted to three filter entries: 'Pascal files (*.pas)' + '*.pas' 'Pascal files (*.pp)' + '*.pp' 'Pascal files (*.lpr)' + '*.lpr' ------------------------------------------------------------------------------} procedure ExtractFilterList(const Filter: string; out ListOfFileSelFilterEntry: TFPList; SplitMultiMask: boolean); var Masks: TStringList; CurFilterIndex: integer; procedure ExtractMasks(const MultiMask: string); var CurMaskStart, CurMaskEnd: integer; s: string; begin if Masks=nil then Masks:=TStringList.Create else Masks.Clear; CurMaskStart:=1; while CurMaskStart<=length(MultiMask) do begin CurMaskEnd:=CurMaskStart; if SplitMultiMask then begin while (CurMaskEnd<=length(MultiMask)) and (MultiMask[CurMaskEnd]<>';') do inc(CurMaskEnd); end else begin CurMaskEnd:=length(MultiMask)+1; end; s:=Trim(copy(MultiMask,CurMaskStart,CurMaskEnd-CurMaskStart)); Masks.Add(s); CurMaskStart:=CurMaskEnd+1; end; end; procedure AddEntry(const Desc, Mask: string); var NewFilterEntry: TFileSelFilterEntry; begin NewFilterEntry:=TFileSelFilterEntry.Create(Desc,Mask); NewFilterEntry.FilterIndex:=CurFilterIndex; ListOfFileSelFilterEntry.Add(NewFilterEntry); end; // remove all but one masks from description string function RemoveOtherMasks(const Desc: string; MaskIndex: integer): string; var i, StartPos, EndPos: integer; begin Result:=Desc; for i:=0 to Masks.Count-1 do begin if i=MaskIndex then continue; StartPos:=Pos(Masks[i],Result); EndPos:=StartPos+length(Masks[i]); if StartPos<1 then continue; while (StartPos>1) and (Result[StartPos-1] in [' ',#9,';']) do dec(StartPos); while (EndPos<=length(Result)) and (Result[EndPos] in [' ',#9]) do inc(EndPos); if (StartPos>1) and (Result[StartPos-1]='(') and (EndPos<=length(Result)) then begin if (Result[EndPos]=')') then begin dec(StartPos); inc(EndPos); end else if Result[EndPos]=';' then begin inc(EndPos); end; end; System.Delete(Result,StartPos,EndPos-StartPos); end; end; procedure AddEntries(const Desc: string; MultiMask: string); var i: integer; CurDesc: string; begin ExtractMasks(MultiMask); for i:=0 to Masks.Count-1 do begin CurDesc:=RemoveOtherMasks(Desc,i); if (Masks.Count>1) and (Pos(Masks[i],CurDesc)<1) then begin if (CurDesc='') or (CurDesc[length(CurDesc)]<>' ') then CurDesc:=CurDesc+' '; CurDesc:=CurDesc+'('+Masks[i]+')'; end; //debugln('AddEntries ',CurDesc,' ',Masks[i]); AddEntry(CurDesc,Masks[i]); end; inc(CurFilterIndex); end; var CurDescStart, CurDescEnd, CurMultiMaskStart, CurMultiMaskEnd: integer; CurDesc, CurMultiMask: string; begin ListOfFileSelFilterEntry:=TFPList.Create; Masks:=nil; CurFilterIndex:=0; CurDescStart:=1; while CurDescStart<=length(Filter) do begin // extract next filter description CurDescEnd:=CurDescStart; while (CurDescEnd<=length(Filter)) and (Filter[CurDescEnd]<>'|') do inc(CurDescEnd); CurDesc:=copy(Filter,CurDescStart,CurDescEnd-CurDescStart); // extract next filter multi mask CurMultiMaskStart:=CurDescEnd+1; CurMultiMaskEnd:=CurMultiMaskStart; while (CurMultiMaskEnd<=length(Filter)) and (Filter[CurMultiMaskEnd]<>'|') do inc(CurMultiMaskEnd); CurMultiMask:=copy(Filter,CurMultiMaskStart,CurMultiMaskEnd-CurMultiMaskStart); if CurDesc='' then CurDesc:=CurMultiMask; // add filter(s) if (CurMultiMask<>'') or (CurDesc<>'') then AddEntries(CurDesc,CurMultiMask); // next filter CurDescStart:=CurMultiMaskEnd+1; end; Masks.Free; end; procedure FreeListOfFileSelFilterEntry(ListOfFileSelFilterEntry: TFPList); var i: Integer; begin if ListOfFileSelFilterEntry=nil then exit; for i:=0 to ListOfFileSelFilterEntry.Count-1 do TObject(ListOfFileSelFilterEntry[i]).Free; ListOfFileSelFilterEntry.Free; end; {------------------------------------------------------------------------------- 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 := TGtk3Dialog(OpenDialog.Handle).Widget; FileName := gtk_file_chooser_get_filename(PGtkFileChooser(Widget)); 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-}TGtk3Dialog(OpenDialog.Handle).Widget, '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; {------------------------------------------------------------------------------ Procedure: StoreCommonDialogSetup Params: ADialog: TCommonDialog Returns: none Stores the size of a TCommonDialog. ------------------------------------------------------------------------------} procedure StoreCommonDialogSetup(ADialog: TCommonDialog); var DlgWindow: PGtkWidget; begin if (ADialog=nil) or not ADialog.HandleAllocated then exit; DlgWindow := TGtk3Dialog(ADialog.Handle).Widget; if DlgWindow^.get_allocated_width > 0 then ADialog.Width := DlgWindow^.get_allocated_width; if DlgWindow^.get_allocated_height > 0 then ADialog.Height := DlgWindow^.get_allocated_height; end; {------------------------------------------------------------------------------ Procedure: DestroyCommonDialogAddOns Params: ADialog: TCommonDialog Returns: none Free the memory of additional data of a TCommonDialog ------------------------------------------------------------------------------} procedure DestroyCommonDialogAddOns(ADialog: TCommonDialog); var DlgWindow: PGtkWidget; HistoryList: TFPList; // list of TFileSelHistoryListEntry AHistoryEntry: PFileSelHistoryEntry; i: integer; // FileSelWidget: PGtkFileSelection; LCLHistoryMenu: PGTKWidget; begin if (ADialog=nil) or (not ADialog.HandleAllocated) then exit; (*TODO: PGtkFileSelection is deprecated in gtk3 DlgWindow:={%H-}PGtkWidget(ADialog.Handle); gtk_window_set_transient_for(PGtkWindow(DlgWindow),nil); if ADialog is TOpenDialog then begin FileSelWidget:=GTK_FILE_CHOOSER(DlgWindow); LCLHistoryMenu:=PGTKWidget(g_object_get_data(PGObject(FileSelWidget), 'LCLHistoryMenu')); if LCLHistoryMenu<>nil then FreeWidgetInfo(LCLHistoryMenu); // free history HistoryList:=TFPList(g_object_get_data(PGObject(DlgWindow), 'LCLHistoryList')); if HistoryList<>nil then begin for i:=0 to HistoryList.Count-1 do begin AHistoryEntry:=PFileSelHistoryEntry(HistoryList[i]); StrDispose(AHistoryEntry^.Filename); AHistoryEntry^.Filename:=nil; Dispose(AHistoryEntry); end; HistoryList.Free; g_object_set_data(PGObject(DlgWindow),'LCLHistoryList',nil); end; // free preview handle if ADialog is TPreviewFileDialog then begin if TPreviewFileDialog(ADialog).PreviewFileControl<>nil then TPreviewFileDialog(ADialog).PreviewFileControl.Handle:=0; end; end; *) end; // ---------------------- signals ---------------------------------------------- procedure gtkFileChooserSelectionChangedCB(Chooser: PGtkFileChooser; Data: Pointer); cdecl; var cFilename: Pgchar; theDialog: TFileDialog; begin //DebugLn(['gtkFileChooserSelectionChangedCB ']); cFilename := gtk_file_chooser_get_filename(Chooser); theDialog := TFileDialog(TGtk3Dialog(Data).CommonDialog); try if theDialog is TOpenDialog then UpdateDetailView(TOpenDialog(theDialog)); finally if Assigned(cFilename) then g_free(cFilename); end; 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 := (gtk_file_chooser_get_action(Widget) = GTK_FILE_CHOOSER_ACTION_OPEN) and DirectoryExists(AName); end; var TheDialog: TFileDialog; cFilename: PChar; cFilenames: PGSList; cFilenames1: PGSList; Files: TStringList; begin //DebugLn(['Gtk3FileChooserResponseCB ']); theDialog := TFileDialog(TGtk3Dialog(Data).CommonDialog); 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 if not SkipDirectory(cFileName) then AddFile(Files, cFilename); 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 if SkipDirectory(cFileName) 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(TGtk3Dialog(user_data).CommonDialog); GtkFilter := gtk_file_chooser_get_filter(PGtkFileChooser(dialog)); GtkFilterList := gtk_file_chooser_list_filters(PGtkFileChooser(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(PGtkFileChooser(dialog), GtkFilter); end else begin NewFilterIndex := g_slist_index(GtkFilterList, Pgpointer(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 Result := False; DebugLn('Gtk3WSDialogs: WARNING gtkDialogSelectRowCB is not implemented since PGtkFileSelection is deprecated.'); (* //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 := False; if (Widget=nil) then ; theDialog := TCommonDialog(TGtk3Dialog(data).CommonDialog); 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; FontChooser: PGtkFontChooser; FontDesc: PPangoFontDescription; APangoFontFamily: PPangoFontFamily; begin Result := False; if (Widget=nil) then ; theDialog := TCommonDialog(TGtk3Dialog(data).CommonDialog); if (theDialog is TFontDialog) and (fdApplyButton in TFontDialog(theDialog).Options) and (Assigned(TFontDialog(theDialog).OnApplyClicked)) then begin FontChooser := PGtkFontChooser(TGtk3Dialog(data).Widget); APangoFontFamily := gtk_font_chooser_get_font_family(FontChooser); FontName := APangoFontFamily^.get_name; //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 : PGSList; FontDesc: PPangoFontDescription; DirName : string; FileName : string; Files: TStringList; CurFilename: string; //SelectedFont: PGdkFont; x: Integer; Argba: TGdkRGBA; ARed: Byte; AGreen: Byte; ABlue: Byte; 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(TGtk3Dialog(data).CommonDialog); FPointer := Pointer(TGtk3Dialog(theDialog.Handle).Widget); if theDialog is TFileDialog then begin FileName := gtk_file_chooser_get_filename(PGtkFileChooser(FPointer)); 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)); FileList := gtk_file_chooser_get_filenames(PGtkFileChooser(FPointer)); rowNum := 0; for x := 0 to g_slist_length(FileList) - 1 do // while FileList^ <> nil do begin fileInfo := g_slist_nth_data(FileList, x); // FileList^; CurFilename := FileInfo; // convert PChar to AnsiString (not typecast) 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_slist_free(FileList); // g_strfreev(fileList); end else begin Result:=CheckOpenedFilename(Filename); if not Result then exit; TFileDialog(TGtk3Dialog(data).CommonDialog).FileName := Filename; end; end else TFileDialog(TGtk3Dialog(data).CommonDialog).FileName := Filename; end else if theDialog is TColorDialog then begin colorSel := PGtkColorSelection(PGtkColorSelectionDialog(FPointer)^.color_selection); gtk_color_selection_get_current_rgba(ColorSel, @Argba); // gtk_color_selection_get_current_color(colorsel, @newColor); // ARed := (AColor and $FF) / 255; // AGreen := ((AColor shr 8) and $FF) / 255; // ABlue := ((AColor shr 16) and $FF) / 255; ARed := Byte(Round(Argba.red * 255)); AGreen := Byte(Round(Argba.green * 255)); ABlue := Byte(Round(Argba.blue * 255)); TColorDialog(theDialog).Color := RGBToColor(ARed, AGreen, ABlue); {$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_chooser_get_font(PGtkFontChooser(FPointer)); // 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 := False; 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; AHandle: HWND; begin Result := False; if (Data=nil) then ; if Widget^.get_has_window and Gtk3IsGdkWindow(Widget^.window) then begin gdk_window_set_events(Widget^.window, gdk_window_get_events(Widget^.window) or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK); end; AHandle := HwndFromGtkWidget(Widget); if (AHandle <> 0) and (wtDialog in TGtk3Widget(AHandle).WidgetType) then begin LCLComponent := TGtk3Dialog(AHandle).CommonDialog; if LCLComponent is TCommonDialog then 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 -------------------------------------------------------------------------------} function gtkDialogCloseQueryCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl; var theDialog : TCommonDialog; CanClose: boolean; AHandle: HWND; begin Result := False; // true = do nothing, false = destroy or hide window if (Data=nil) then ; // data is not the commondialog. Get it manually. AHandle := HwndFromGtkWidget(Widget); if (AHandle <> 0) and (wtDialog in TGtk3Widget(AHandle).WidgetType) then begin theDialog := TGtk3Dialog(AHandle).CommonDialog; if theDialog = nil then exit; if theDialog.OnCanClose<>nil then begin CanClose:=True; theDialog.DoCanClose(CanClose); Result := not CanClose; end; if not Result then begin StoreCommonDialogSetup(theDialog); DestroyCommonDialogAddOns(theDialog); end; end; 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 Result := True; if (Widget=nil) then ; TCommonDialog(data).UserChoice := mrCancel; TCommonDialog(data).Close; 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 //debugln('GTKDialogKeyUpDownCB A '); Result := False; (* 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 := False; 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; *) 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 gtk_file_chooser_set_current_folder({%H-}PGtkFileChooser(theDialog.Handle),AHistoryEntry^.Filename); UpdateDetailView(TOpenDialog(theDialog)); end; end; *) end; // ---------------------- END OF signals --------------------------------------- { TGtk3WSOpenDialog } class function TGtk3WSOpenDialog.CreateOpenDialogFilter( OpenDialog: TOpenDialog; SelWidget: PGtkWidget): string; var ListOfFileSelFilterEntry: TFPList; i, j, k: integer; GtkFilter, GtkSelFilter: PGtkFileFilter; MaskList: TStringList; FilterEntry: TFileSelFilterEntry; FilterIndex: Integer; 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 gtk_file_filter_add_pattern(GtkFilter, PgChar(MaskList.Strings[k])); gtk_file_filter_set_name(GtkFilter, PgChar(FilterEntry.Description)); gtk_file_chooser_add_filter(PGtkFileChooser(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(PGtkFileChooser(SelWidget), GtkSelFilter); Result := 'hm'; { Don't use '' as null return as this is used for *.* } end; class procedure TGtk3WSOpenDialog.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 TGtk3WSOpenDialog.CreatePreviewDialogControl( PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget); var PreviewWidget: PGtkWidget; AControl: TPreviewFileControl; FileChooser: PGtkFileChooser; begin AControl := PreviewDialog.PreviewFileControl; if AControl = nil then Exit; FileChooser := PGtkFileChooser(SelWidget); PreviewWidget := TGtk3CustomControl(AControl.Handle).Widget; g_object_set_data(PGObject(PreviewWidget),'LCLPreviewFixed', PreviewWidget); gtk_widget_set_size_request(PreviewWidget,AControl.Width,AControl.Height); gtk_file_chooser_set_preview_widget(FileChooser, PreviewWidget); gtk_widget_show(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 TGtk3WSOpenDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; var FileSelWidget: PGtkFileChooser; OpenDialog: TOpenDialog absolute ACommonDialog; HelpButton: PGtkWidget; InitialFilename: String; //FrameWidget: PGtkWidget; //HBox: PGtkWidget; //FileDetailLabel: PGtkWidget; begin Result := THandle(TGtk3FileDialog.Create(ACommonDialog)); TGtk3WSFileDialog.SetCallbacks(TGtk3Dialog(Result).Widget, TGtk3Dialog(Result)); FileSelWidget := PGtkFileChooser(TGtk3FileDialog(Result).Widget); if OpenDialog.InheritsFrom(TSaveDialog) then begin if OpenDialog.InitialDir <> '' then gtk_file_chooser_set_current_folder(FileSelWidget, Pgchar(OpenDialog.InitialDir)); end; // Help button if (ofShowHelp in OpenDialog.Options) then begin HelpButton := gtk_dialog_add_button(PGtkDialog(FileSelWidget), GTK_STOCK_HELP, GTK_RESPONSE_NONE); g_signal_connect_data(HelpButton, 'clicked', TGCallback(@gtkDialogHelpclickedCB), TGtk3Dialog(Result), nil, 0); end; if ofAllowMultiSelect in OpenDialog.Options then gtk_file_chooser_set_select_multiple(FileSelWidget, True); // History List - a frame with an option menu CreateOpenDialogHistory(OpenDialog, PGtkWidget(FileSelWidget)); // Filter CreateOpenDialogFilter(OpenDialog, PGtkWidget(FileSelWidget)); // connect change event g_signal_connect_data(FileSelWidget, 'selection-changed', TGCallback(@gtkFileChooserSelectionChangedCB), TGtk3Dialog(Result), nil, 0); // 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); gtk_file_chooser_set_filename(FileSelWidget, PChar(InitialFilename)); end; //if InitialFilter <> 'none' then // PopulateFileAndDirectoryLists(FileSelWidget, InitialFilter); end; { TGtk3WSFileDialog } class procedure TGtk3WSFileDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); begin TGtk3WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); g_signal_connect_data(AGtkWidget, 'response', TGCallback(@Gtk2FileChooserResponseCB), AWidgetInfo, nil, 0); g_signal_connect_data(AGtkWidget, 'notify', TGCallback(@Gtk2FileChooserNotifyCB), AWidgetInfo, nil, 0); end; { Creates a new TFile/Open/SaveDialog } class function TGtk3WSFileDialog.CreateHandle(const ACommonDialog: TCommonDialog ): THandle; var FileDialog: TFileDialog absolute ACommonDialog; Action: TGtkFileChooserAction; Button1: String; Widget: PGtkWidget; ADialog: TGtk3FileDialog; AFileDialog: PGtkFileChooserDialog; AParams: TCreateParams; 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; Result := THandle(TGtk3FileDialog.Create(ACommonDialog)); // AFileDialog := PGtkFileChooserDialog(ADialog.Widget); // AFileDialog^.set_title(PChar(FileDialog.Title)); // AFileDialog^.set_r (* 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 gtk_file_chooser_set_current_folder(Widget, Pgchar(FileDialog.InitialDir)); 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; TGtk3WSCommonDialog.SetSizes(Widget, WidgetInfo); // SetCallbacks(Widget, WidgetInfo); *) end; { TGtk3WSCommonDialog } {------------------------------------------------------------------------------ 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 TGtk3WSCommonDialog.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 TGtk3WSCommonDialog.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]); 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 TGtk3WSCommonDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); begin g_signal_connect_data(AGtkWidget, 'destroy', TGCallback(@gtkDialogDestroyCB), AWidgetInfo, nil, 0); g_signal_connect_data(AGtkWidget, 'delete-event', TGCallback(@gtkDialogCloseQueryCB), AWidgetInfo, nil, 0); g_signal_connect_data(AGtkWidget, 'key-press-event', TGCallback(@GTKDialogKeyUpDownCB), AWidgetInfo, nil, 0); g_signal_connect_data(AGtkWidget, 'key-release-event', TGCallback(@GTKDialogKeyUpDownCB), AWidgetInfo, nil, 0); g_signal_connect_data(AGtkWidget, 'realize', TGCallback(@GTKDialogRealizeCB), AWidgetInfo, nil, 0); end; class procedure TGtk3WSCommonDialog.SetSizes(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); var NewWidth, NewHeight: integer; begin // set default size NewWidth := TCommonDialog(AWidgetInfo.CommonDialog).Width; if NewWidth <= 0 then NewWidth := -2; // -2 = let the window manager decide NewHeight := TCommonDialog(AWidgetInfo.CommonDialog).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 TGtk3WSCommonDialog.CreateHandle( const ACommonDialog: TCommonDialog): THandle; begin Result := 0; end; class procedure TGtk3WSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog); var AGtkWindow: PGtkWidget; begin if not ACommonDialog.HandleAllocated then exit; AGtkWindow := TGtk3Dialog(ACommonDialog.Handle).Widget; DebugLn('TGtk3WSCommonDialog.ShowModal widget ',dbgHex(PtrUInt(AGtkWindow))); if not Gtk3IsWidget(AGtkWindow) then raise Exception.Create('TGtk3WSCommonDialog.ShowModal error'); // ReleaseMouseCapture; // GtkWindow^.set_title(PChar(ACommonDialog.Title)); PGtkDialog(AGtkWindow)^.set_position(GTK_WIN_POS_CENTER); PGtkDialog(AGtkWindow)^.set_application(GTK3WidgetSet.Gtk3Application); PGtkDialog(AGtkWindow)^.set_modal(True); PGtkDialog(AGtkWindow)^.show_all; PGtkDialog(AGtkWindow)^.present; (* 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 TGtk3WSCommonDialog.DestroyHandle( const ACommonDialog: TCommonDialog); begin { TODO: cleanup } DebugLn('TGtk3WSCommonDialog.DestroyHandle '); if ACommonDialog.HandleAllocated then TGtk3Dialog(ACommonDialog.Handle).Free; // TGtk3WidgetSet(WidgetSet).DestroyLCLComponent(ACommonDialog); end; { TGtk3WSColorDialog } class procedure TGtk3WSColorDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); begin TGtk3WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); (* TODO: must hack into colorselection dialog to get button pointers. g_signal_connect_data(PGtkColorSelectionDialog(AGtkWidget)^.ok_button, 'clicked', TGCallback(@gtkDialogOKclickedCB), AWidgetInfo, nil, 0); g_signal_connect_data(PGtkObject(PGtkColorSelectionDialog(AGtkWidget)^.cancel_button), 'clicked', TGCallback(@gtkDialogCancelclickedCB), AWidgetInfo, nil, 0); *) end; class function TGtk3WSColorDialog.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; TGtk3WSCommonDialog.SetSizes(Widget, WidgetInfo); // SetCallbacks(Widget, WidgetInfo); *) end; { TGtk3WSFontDialog } class procedure TGtk3WSFontDialog.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: TGtk3Dialog); begin TGtk3WSCommonDialog.SetCallbacks(AGtkWidget, AWidgetInfo); // connect Ok, Cancel and Apply Button (*TODO: must hack into private to get button pointers g_signal_connect_data( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.ok_button), 'clicked', TGCallback(@gtkDialogOKclickedCB), AWidgetInfo, nil, 0); g_signal_connect_data( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.cancel_button), 'clicked', TGCallback(@gtkDialogCancelclickedCB), AWidgetInfo, nil, 0); g_signal_connect_data( PGtkObject(PGtkFontSelectionDialog(AGtkWidget)^.apply_button), 'clicked', TGCallback(@gtkDialogApplyclickedCB), AWidgetInfo, nil, 0); *) end; class function TGtk3WSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle; var FontDesc: PPangoFontDescription; TmpStr: pChar; Widget: PGtkWidget; // WidgetInfo: PWidgetInfo; FontDialog: TFontDialog absolute ACommonDialog; begin (* GtkFontSelectionDialog is deprecated since gtk3-3.2, we must use GtkFontChooserDialog - > gtk_font_chooser_dialog_new(); 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; TGtk3WSCommonDialog.SetSizes(Widget, WidgetInfo); // SetCallbacks(Widget, WidgetInfo); *) end; end.