Re: [fpc-pascal]parameter is 0x0 on callback

[Marc Santhoff]

Here it is (as attachment, hopefully the list processor doesn't strip it
off):



unit browser192;

{$define debug}
interface
uses sysutils, glib, gdk, gtk, unix;

const
        SEP: char = ';';
        QT: char = '"';

type
        TCustomer = class
                Name: AnsiString;
                FirstName: AnsiString;
                Street: AnsiString;
                Zip: Ansistring;
                City: AnsiString;
                Phone: AnsiString;
                function asCSV: AnsiString;
        end;
                
        TPropagateCallback = procedure(data: TCustomer);
        
        CustomerBrowserClass = class of TCustomerBrowser;

        TCustomerBrowser = class
        public
                dialog: pGtkWidget; { access for caller granted }

                constructor create(callback: TPropagateCallback);
                destructor destroy; override;
                function execute: boolean;
        private
                btnOkay: pGtkWidget;
                btnCancel: pGtkWidget;
                headline: pGtkWidget;
                scroll: pGtkWidget;
        end;
                
procedure onCustOkay(data : pGtkCList ); cdecl;

var
        cbPropagate     : TPropagateCallback;
        _me                     : pGtkWidget;

implementation


function TCustomer.asCSV: AnsiString;
begin
        result := 
                        SEP + QT + Name + QT +
                        SEP + QT + FirstName + QT +
                        SEP + QT + Street + QT +
                        SEP + QT + ZIP + QT +
                        SEP + QT + City + QT +
        SEP + QT + Phone + QT;
end;

procedure onCustOkay(data : pGtkCList ); cdecl;
var
        src: TCustomer;
begin
        src := TCustomer.create;
        src.Name := 'The Name';
        src.FirstName := 'FirstName';
        {$ifdef debug} writeln(src.asCSV); {$endif}
        
        { propagate selected entry }
        cbPropagate(src);

        gtk_widget_destroy(_me);

end; { onCustOkay }

constructor TCustomerBrowser.create(callback: TPropagateCallback);
begin
        inherited create;

        cbPropagate := callback;
        
        dialog := gtk_dialog_new();
        gtk_window_set_modal(GTK_WINDOW(dialog), TRUE);
        gtk_window_set_position(pGtkWindow(dialog), GTK_WIN_POS_CENTER);
        gtk_widget_set_usize(dialog, 500, 400);
        gtk_container_set_border_width(pGTKCONTAINER(dialog), 24);
        _me := dialog;

        headline := gtk_label_new(PChar('Any Headline'));

        gtk_box_pack_start( pGtkBox(GTK_DIALOG(dialog)^.vbox) , headline, FALSE, 
FALSE, 5);

        { --- button OK --- }
        btnOkay := gtk_button_new_with_label('do call back');
        
        { transport data to caller via callback on 'OK' }
        gtk_signal_connect_object (GTK_OBJECT (btnOkay), 'clicked',
                        GTK_SIGNAL_FUNC (@onCustOkay), nil);
                        
        gtk_container_add (GTK_CONTAINER (GTK_DIALOG(dialog)^.action_area),
                        btnOkay);

end;

destructor TCustomerBrowser.destroy;
begin
        { nothing yet }
end;

function TCustomerBrowser.execute: boolean;
begin
        result := FALSE;
        gtk_widget_show_all (dialog);
end;

END.

program main192;
{$mode objfpc}
uses sysutils, glib, gdk, gtk, browser192;
        
var
        window : pGtkWidget;
        c          : pGtkWidget;
        br         : TCustomerBrowser;


procedure destroy(widget : pGtkWidget ; data: pgpointer ); cdecl;
begin
        if assigned(br) then br.free;
        gtk_main_quit();
end;

procedure setCustDataCallback(data: TCustomer); cdecl;
begin
        writeln('callback: Name is '+data.Name);
end;

procedure showCustomerBrowser(btn: pGtkButton; data: gpointer); cdecl;
begin
        writeln('showCustomerBrowser start');
        br := TCustomerBrowser.create(@setCustDataCallback);
        writeln('browser created');
        br.execute;
end;

BEGIN

        gtk_init (@argc, @argv);

        window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
        c := gtk_button_new_with_label('show browser');
        gtk_container_add(GTK_CONTAINER(window), c);
        gtk_signal_connect(GTK_OBJECT(c), 'clicked',
                                           GTK_SIGNAL_FUNC(@showCustomerBrowser), NIL);
        
        gtk_signal_connect (pGTKOBJECT(window), 'destroy',
                                                GTK_SIGNAL_FUNC (@destroy), NULL);
        gtk_widget_show_all(window);
        gtk_widget_show (window);

        gtk_main ();
        
END.