Am Fr, den 04.06.2004 schrieb Peter Vreman um 08:46:
[...]
> Without a full (short) example we can't do anything.
See below, I've tried to cut down the size without loosing to much
information this time ...
> > And why it worked fine on the 1.0.10 version of fpc?
>
> 1.9.2 uses register calling by default.
I don't get that. Do you say it worked by accident?
The code:
------------------------
unit StateInput;
{$define debug}
interface
...
procedure setCustDataCallback(data: TCustomer); cdecl;
...
implementation
procedure setCustDataCallback(data: TCustomer); cdecl;
begin
writeln('Name is '+_data.Name);
with _data do begin
if (Name <> '') then gtk_entry_set_text(_me.entries[0], pchar(@Name));
if (FirstName <> '') then gtk_entry_set_text(_me.entries[1],
pchar(@FirstName));
...
end;
procedure showCustomerBrowser(btn: pGtkButton; data: gpointer); cdecl;
var
ds: TDataSource;
begin
writeln('SI: showCustomerBrowser start');
if not(DBMan=NIL) then ds := DBMan.customers else writeln('SI: DBMan=NIL!');
br := TCustomerBrowser.create(ds, @setCustDataCallback);
writeln('SI: browser created');
br.execute;
end;
---------------------------------
unit CustomerBrowser;
type
TPropagateCallback = procedure(data: TCustomer);
TCustomerBrowser = class
public
dialog: pGtkWidget; { access for caller granted }
constructor create(data: TDataSource; callback: TPropagateCallback);
destructor destroy; override;
function execute: boolean;
private
btnOkay: pGtkWidget;
btnCancel: pGtkWidget;
headline: pGtkWidget;
scroll: pGtkWidget;
list: pGtkWidget;
procedure fillCustomerList(l: pGtkCList);
end;
procedure onCustOkay(data : pGtkCList ); cdecl;
var { should be props, doesn't work with callbacks }
cbPropagate : TPropagateCallback;
...
implementation
constructor TCustomerBrowser.create(data: TDataSource; callback: TPropagateCallback);
begin
inherited create;
_creating := TRUE;
cbPropagate := callback;
...
end;
procedure onCustOkay(data : pGtkCList ); cdecl;
var
src: TCustomer;
dlg: pGtkDialog;
btnOk: pGtkWidget;
(*towait, remain : timespec;*)
begin
if (selCursor > -1) then begin
{ fetch selected entry }
selCursor := datasrc.indexOfID(selCursor);
gtk_clist_set_auto_sort(data, FALSE);
src := TCustomer(datasrc.Items[selCursor]);
{$ifdef debug} writeln(src.asCSV); {$endif}
{ propagate selected entry }
cbPropagate(src);
gtk_widget_destroy(_me);
...
end;
----------------------------
unit CommonTypes;
interface
...
type
TCustomerClass = class of TCustomer;
TCustomer = class(TStorable)
Name: AnsiString;
FirstName: AnsiString;
Street: AnsiString;
Zip: Ansistring;
City: AnsiString;
...
function asCSV: AnsiString; override;
procedure fillFromCSV(csv: AnsiString); override;
class function getHeaderString: AnsiString; override; { first line of
CSV format }
end;
const
SEP: char = ';';
QT: char = '"';
implementation
function TCustomer.asCSV: AnsiString;
begin
result := IntToStr(ID) +
SEP + QT + Name + QT +
SEP + QT + FirstName + QT +
SEP + QT + Street + QT +
SEP + QT + ZIP + QT +
SEP + QT + City + QT +
SEP + QT + Phone + QT +
...
{$ifdef debug}writeln('CT:customer.asCSV:'+result);{$endif}
end;
---------------------
I hope there is a solution. As written, the TCustomer item "src" should
be handed over to the code calling the browser dialog and it's zero any
time in the callback in the first unit.
Writing out it's content in the code that makes the call to the callback
with "asCSV" works okay, the contained information is correct.
Marc
_______________________________________________
fpc-pascal maillist - [EMAIL PROTECTED]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
