[lazarus] dialogs 0.2

[Sergio A. Kessler]

Oh, man, this is working really nice, even if the stupid user
close the window.

test with:

Procedure TEditor.LoadFile;
begin
     Writeln('--> Enterring TEditor.Loadfile (should be LoadFromFile( 
fname))');
     OpenFileDialog1 := TOpenFileDialog.Create(Self);
     OpenFileDialog1.Title := 'Select a file';
     OpenFileDialog1.Filter := '*.pp';
     if OpenFileDialog1.Execute then
     begin
          Writeln('--> in OpenFileDialog1.Execute');
     end;
     Writeln('--> out of OpenFileDialog1.Execute');
     OpenFileDialog1.Free;
End;



attached (really this time) and pasted here:

//==================================================================
//
//     Dialogs Unit
//
//     Contains : TOpenFileDialog
//
//
//     Authors: Sergio A. Kessler, ...
//
//
//     Licensee: in consideration.
//
//     Version: 0.2
//
//==================================================================


unit dialogs;

{$mode objfpc}

interface

uses
    gtk, classes, Controls, vclGlobals;


type
	TCustomDialog = class(TWinControl)
	private
	 FUserChoice: integer;
	 FFileName : PChar;
	 FTitle: PChar;
	 FFilter: PChar;
         function gtk_Ok( widget: PGtkWidget) : Boolean; cdecl;
	 function gtk_Cancel( widget: PGtkWidget) : Boolean; cdecl;
	 function gtk_Close( widget: PGtkWidget) : Boolean; cdecl;
	protected
	public
	 constructor Create(AOwner : TComponent); override;
	 destructor destroy; override;
	 property FileName : PChar read FFileName write FFileName;
	 property Title : PChar read FTitle write FTitle;
	 property Filter : PChar read FFilter write FFilter;
	end;

	TOpenFileDialog  = class(TCustomDialog)
	private
	 procedure gtk_create;
	 procedure gtk_destroy;
	public
	 constructor Create (AOwner : TComponent); override;
	 destructor destroy; override;

	 Function Execute : boolean;
	end;


Implementation

//--------------------------------------------------------------------------
--

function TCustomDialog.gtk_Ok( widget: PGtkWidget) : Boolean; cdecl;
begin
     writeln('--> in gtk_ok');
     FUserChoice := 1;
end;

//--------------------------------------------------------------------------
--

function TCustomDialog.gtk_Cancel( widget: PGtkWidget) : Boolean; cdecl;
begin
     writeln('--> in gtk_cancel');
     FUserChoice := 2;
end;

//--------------------------------------------------------------------------
--

function TCustomDialog.gtk_Close( widget: PGtkWidget) : Boolean; cdecl;
begin
     writeln('--> in gtk_close');
     FUserChoice := 3;
end;

//--------------------------------------------------------------------------
--

constructor TCustomDialog.Create (AOwner : TComponent);
begin
     // the TCustomDialog should not create the file_selection
     inherited Create(AOwner);
End;

//--------------------------------------------------------------------------
--

destructor TCustomDialog.destroy;
begin
     inherited Destroy;
End;

//--------------------------------------------------------------------------
--


constructor TOpenFileDialog.Create (AOwner : TComponent);
begin
     inherited Create(AOwner);
     gtk_create;
end;

//--------------------------------------------------------------------------
--

destructor TOpenFileDialog.destroy;
begin
     gtk_destroy;
     inherited Destroy;
end;

//--------------------------------------------------------------------------
--

Function TOpenFileDialog.Execute : boolean;
begin
     if not (GTK_IS_FILE_SELECTION( FComponent)) then gtk_create;

     if FTitle <> '' then
     begin
        gtk_window_set_title( @((PGtkFileSelection( FComponent))^.Window),
                              FTitle);
     end;
     
     if FFileName <> '' then
     begin
        gtk_file_selection_set_filename( PGtkFileSelection( FComponent),
                                         FFileName);
     end;

     if FFilter <> '' then
     begin
        gtk_file_selection_complete( PGtkFileSelection( FComponent),
                                     FFilter);
     end;
     
     FUserChoice := 0;
     writeln('--> about to file_sel_show');
     gtk_widget_show( FComponent);
     repeat
          gtk_main_iteration;
     until FUserChoice <> 0;

     writeln('--> about to file_sel_hide');
     if (FUserChoice <> 3) then gtk_widget_hide( FComponent);

     Execute := (FUserChoice = 1);
     if Execute then
     begin
          FFileName := gtk_file_selection_get_filename( PGtkFileSelection( 
FComponent));
     end;
end;


Procedure TOpenFileDialog.gtk_create;
begin
     FComponent := gtk_file_selection_new( FTitle);
     
     gtk_window_set_modal( @((PGtkFileSelection( FComponent))^.Window), 
True);

     gtk_signal_connect_object( gtk_object( 
(PGtkFileSelection(FComponent))^.ok_button),
                                'clicked',
                                gtk_signal_func( @gtk_ok),
                                gtk_object( self));
                                       
     gtk_signal_connect_object( gtk_object( 
(PGtkFileSelection(FComponent))^.cancel_button),
                                'clicked',
                                gtk_signal_func( @gtk_cancel),
                                gtk_object( self));
                                       
     gtk_signal_connect_object( gtk_object( FComponent),
                                'destroy',
                                gtk_signal_func( @gtk_close),
                                gtk_object( self));
end;


Procedure TOpenFileDialog.gtk_destroy;
begin
     if (GTK_IS_FILE_SELECTION( FComponent)) then
     begin
         writeln('--> destroying file_selection');
         gtk_signal_handlers_destroy( gtk_object( 
(PGtkFileSelection(FComponent))^.ok_button));
         gtk_signal_handlers_destroy( gtk_object( 
(PGtkFileSelection(FComponent))^.cancel_button));
         gtk_signal_handlers_destroy( gtk_object( FComponent));
         gtk_widget_destroy( PGtkWidget( FComponent));
     end;
end;

end.

-------------- next part --------------
A non-text attachment was scrubbed...
Name: bin00003.bin
Type: application/octet-stream
Size: 5267 bytes
Desc: "Dialogs.pp"
Url : http://localhost/pipermail/lazarus/attachments/19990519/4cd35d98/bin00003.bin