mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-13 09:00:04 +02:00
gtk2 intf can now optionally use the file chooses, compile with HasGTK2_6
git-svn-id: trunk@8194 -
This commit is contained in:
mattias
parent
00d2646d1b
commit
f5ff9d9bd6
@ -220,16 +220,16 @@ type
|
||||
AWinControl: TWinControl);virtual;
|
||||
procedure UntransientWindow(GtkWindow: PGtkWindow);
|
||||
procedure InitializeFileDialog(FileDialog: TFileDialog;
|
||||
var SelWidget: PGtkWidget; Title: PChar);
|
||||
var SelWidget: PGtkWidget; Title: PChar); virtual;
|
||||
procedure InitializeFontDialog(FontDialog: TFontDialog;
|
||||
var SelWidget: PGtkWidget; Title: PChar);
|
||||
procedure InitializeCommonDialog(ADialog: TObject; AWindow: PGtkWidget);
|
||||
function CreateOpenDialogFilter(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget): string;
|
||||
SelWidget: PGtkWidget): string; virtual;
|
||||
procedure CreatePreviewDialogControl(PreviewDialog: TPreviewFileDialog;
|
||||
SelWidget: PGtkWidget);
|
||||
SelWidget: PGtkWidget); virtual;
|
||||
procedure InitializeOpenDialog(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget);
|
||||
SelWidget: PGtkWidget); virtual;
|
||||
|
||||
// misc
|
||||
Function GetCaption(Sender : TObject) : String; virtual;
|
||||
@ -299,6 +299,7 @@ type
|
||||
end;
|
||||
|
||||
{$I gtklistslh.inc}
|
||||
{$I gtkfiledialogutilsh.inc}
|
||||
|
||||
var
|
||||
GTKWidgetSet: TGTKWidgetSet;
|
||||
@ -346,6 +347,7 @@ const
|
||||
GtkNil = nil;
|
||||
|
||||
{$I gtklistsl.inc}
|
||||
{$I gtkfiledialogutils.inc}
|
||||
{$I gtkobject.inc}
|
||||
{$I gtkwinapi.inc}
|
||||
{$I gtklclintf.inc}
|
||||
|
||||
@ -4163,143 +4163,6 @@ begin
|
||||
gtk_object_set_data(PGtkObject(SelWidget), 'LCLHistoryList', HistoryList);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: ExtractFilterList
|
||||
Params: const Filter: string; var FilterIndex: integer;
|
||||
var FilterList: 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 FilterList: 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: PFileSelFilterEntry;
|
||||
begin
|
||||
New(NewFilterEntry);
|
||||
NewFilterEntry^.Description:= StrAlloc(length(Desc)+1);
|
||||
StrPCopy(NewFilterEntry^.Description, Desc);
|
||||
NewFilterEntry^.Mask:= StrAlloc(length(Mask)+1);
|
||||
StrPCopy(NewFilterEntry^.Mask, Mask);
|
||||
NewFilterEntry^.FilterIndex:=CurFilterIndex;
|
||||
FilterList.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
|
||||
FilterList:=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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TGtkWidgetSet.CreateOpenDialogFilter
|
||||
Params: OpenDialog: TOpenDialog; SelWidget: PGtkWidget
|
||||
|
||||
@ -67,6 +67,15 @@ type
|
||||
MultiSelect, ExtendedSelect: boolean); override;
|
||||
//function SetTopIndex(Sender: TObject; NewTopIndex: integer): integer; override;
|
||||
procedure UpdateDCTextMetric(DC: TDeviceContext); override;
|
||||
|
||||
procedure InitializeFileDialog(FileDialog: TFileDialog;
|
||||
var SelWidget: PGtkWidget; Title: PChar); override;
|
||||
function CreateOpenDialogFilter(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget): string; override;
|
||||
procedure InitializeOpenDialog(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget); override;
|
||||
procedure CreatePreviewDialogControl(
|
||||
PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget); override;
|
||||
public
|
||||
{$I gtk2winapih.inc}
|
||||
{$I gtk2lclintfh.inc}
|
||||
|
||||
@ -126,6 +126,69 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{$IFDEF HasGTK2_6}
|
||||
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;
|
||||
|
||||
var
|
||||
TheDialog: TFileDialog;
|
||||
cFilename: PChar;
|
||||
cFilenames: PGSList;
|
||||
cFilenames1: PGSList;
|
||||
Files: TStringList;
|
||||
begin
|
||||
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
|
||||
AddFile(Files, cFilename);
|
||||
g_free(cFilename);
|
||||
end;
|
||||
|
||||
cFilenames1 := cFilenames1^.next;
|
||||
end;
|
||||
|
||||
g_slist_free(cFilenames);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
cFilename := gtk_file_chooser_get_filename(widget);
|
||||
if Assigned(cFilename) then begin
|
||||
TheDialog.FileName := cFilename;
|
||||
g_free(cFilename);
|
||||
end;
|
||||
|
||||
//?? StoreCommonDialogSetup(theDialog);
|
||||
theDialog.UserChoice := mrOK;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
Procedure gtk_clb_toggle(cellrenderertoggle : PGtkCellRendererToggle; arg1 : PGChar;
|
||||
WinControl: TWinControl); cdecl;
|
||||
var
|
||||
@ -1454,6 +1517,198 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TGtk2WidgetSet.InitializeOpenDialog
|
||||
Params: OpenDialog: TOpenDialog; SelWidget: PGtkWidget
|
||||
Returns: -
|
||||
|
||||
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
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TGtk2WidgetSet.InitializeOpenDialog(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget);
|
||||
{$IFDEF HasGTK2_6}
|
||||
var
|
||||
FileSelWidget: PGtkFileChooser;
|
||||
HelpButton: PGtkWidget;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF HasGTK2_6}
|
||||
FileSelWidget := GTK_FILE_CHOOSER(SelWidget);
|
||||
|
||||
// Help button
|
||||
if (ofShowHelp in OpenDialog.Options) then begin
|
||||
HelpButton := gtk_dialog_add_button(FileSelWidget, GTK_STOCK_HELP, GTK_RESPONSE_NONE);
|
||||
|
||||
g_signal_connect( gtk_object(HelpButton),
|
||||
'clicked', gtk_signal_func(@gtkDialogHelpclickedCB), OpenDialog);
|
||||
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, SelWidget);
|
||||
|
||||
// // Filter - a frame with an option menu
|
||||
CreateOpenDialogFilter(OpenDialog,SelWidget);
|
||||
|
||||
// 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_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;
|
||||
gtk_object_set_data(PGtkObject(SelWidget), 'FileDetailLabel',
|
||||
FileDetailLabel);
|
||||
|
||||
// preview
|
||||
if (OpenDialog is TPreviewFileDialog) then
|
||||
CreatePreviewDialogControl(TPreviewFileDialog(OpenDialog), SelWidget);
|
||||
|
||||
// set initial filename
|
||||
if OpenDialog.Filename<>'' then
|
||||
gtk_file_chooser_set_filename(FileSelWidget, PChar(OpenDialog.Filename));
|
||||
|
||||
//if InitialFilter <> 'none' then
|
||||
// PopulateFileAndDirectoryLists(FileSelWidget, InitialFilter);
|
||||
{$ELSE}
|
||||
inherited InitializeOpenDialog(OpenDialog,SelWidget);
|
||||
{$ENDIF NONO}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TGtk2WidgetSet.InitializeFileDialog
|
||||
Params: FileDialog: TFileDialog; var SelWidget: PGtkWidget
|
||||
Returns: -
|
||||
|
||||
Creates a new TFile/Open/SaveDialog
|
||||
requires: gtk+ 2.6
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TGtk2WidgetSet.InitializeFileDialog(FileDialog: TFileDialog;
|
||||
var SelWidget: PGtkWidget; Title: PChar);
|
||||
{$IFDEF HasGTK2_6}
|
||||
var
|
||||
Action: TGtkFileChooserAction;
|
||||
Button1: String;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF HasGTK2_6}
|
||||
Action := GTK_FILE_CHOOSER_ACTION_OPEN;
|
||||
Button1 := GTK_STOCK_OPEN;
|
||||
|
||||
if FileDialog is TSaveDialog then begin
|
||||
Action := GTK_FILE_CHOOSER_ACTION_SAVE;
|
||||
Button1 := GTK_STOCK_CANCEL;
|
||||
end;
|
||||
|
||||
SelWidget := gtk_file_chooser_dialog_new(Title, nil, Action,
|
||||
PChar(GTK_STOCK_CANCEL), [GTK_RESPONSE_CANCEL, PChar(Button1), GTK_RESPONSE_OK, nil]);
|
||||
|
||||
g_signal_connect(SelWidget, 'response', gtk_signal_func(@Gtk2FileChooserResponseCB), FileDialog);
|
||||
|
||||
(*gtk 2.8
|
||||
if FileDialog is TSaveDialog then begin
|
||||
gtk_file_chooser_set_do_overwrite_confirmation(SelWidget,
|
||||
ofOverwritePrompt in TOpenDialog(theDialog).Options);
|
||||
end;
|
||||
*)
|
||||
|
||||
if FileDialog is TOpenDialog then
|
||||
InitializeOpenDialog(TOpenDialog(FileDialog), SelWidget);
|
||||
|
||||
InitializeCommonDialog(TCommonDialog(FileDialog), SelWidget);
|
||||
{$ELSE}
|
||||
inherited InitializeFileDialog(FileDialog,SelWidget,Title);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TGtk2WidgetSet.CreateOpenDialogFilter(OpenDialog: TOpenDialog;
|
||||
SelWidget: PGtkWidget): string;
|
||||
{$IFDEF HasGTK2_6}
|
||||
var
|
||||
FilterList: TFPList;
|
||||
i, j: integer;
|
||||
s: String;
|
||||
GtkFilter: PGtkFileFilter;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF HasGTK2_6}
|
||||
ExtractFilterList(OpenDialog.Filter, FilterList, false);
|
||||
if FilterList.Count > 0 then begin
|
||||
j := 1;
|
||||
for i := 0 to FilterList.Count-1 do begin
|
||||
GtkFilter := gtk_file_filter_new();
|
||||
|
||||
gtk_file_filter_add_pattern(GtkFilter, PFileSelFilterEntry(FilterList[i])^.Mask);
|
||||
gtk_file_filter_set_name(GtkFilter, PFileSelFilterEntry(FilterList[i])^.Description);
|
||||
|
||||
gtk_file_chooser_add_filter(SelWidget, GtkFilter);
|
||||
|
||||
if j = OpenDialog.FilterIndex then
|
||||
gtk_file_chooser_set_filter(SelWidget, GtkFilter);
|
||||
|
||||
Inc(j);
|
||||
GtkFilter := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
gtk_object_set_data(PGtkObject(SelWidget), 'LCLFilterList', FilterList);
|
||||
|
||||
Result := 'hm'; { Don't use '' as null return as this is used for *.* }
|
||||
{$ELSE}
|
||||
Result:=inherited CreateOpenDialogFilter(OpenDialog,SelWidget);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TGtk2WidgetSet.CreatePreviewDialogControl(
|
||||
PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget);
|
||||
{$IFDEF HasGTK2_6}
|
||||
var
|
||||
PreviewWidget: PGtkWidget;
|
||||
AControl: TPreviewFileControl;
|
||||
FileChooser: PGtkFileChooser;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF HasGTK2_6}
|
||||
AControl := PreviewDialog.PreviewFileControl;
|
||||
if AControl = nil then Exit;
|
||||
|
||||
FileChooser := PGtkFileChooser(SelWidget);
|
||||
|
||||
PreviewWidget := PGtkWidget(AControl.Handle);
|
||||
|
||||
gtk_object_set_data(PGtkObject(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);
|
||||
{$ELSE}
|
||||
inherited CreatePreviewDialogControl(PreviewDialog,SelWidget);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFDEF ASSERT_IS_ON}
|
||||
{$UNDEF ASSERT_IS_ON}
|
||||
{$C-}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user