[fpc-pascal]parameter is 0x0 on callback

[Marc Santhoff]

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


-------------- next part --------------
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.
-------------- next part --------------
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.