Example to using Livebinding with mORMot

corchi72 · 2013-02-19 10:32:16

Yesterday I asked you an example of how to connect the livebinding of Delphi XE3 with your framework, and since no one had posted I did some tests and I now place.

1) the first thing I had to edit mormot.pas and then as "Samples \ 04 - HTTP Client-Server \ Project04Client.dproj"

I created these two new methods because the existing ones were not compatible with the livebingi of delphi

unit mORMot;
...
uses
...
  Generics.Collections;

...

procedure TSQLTableToObjectGenericList(aRecordClass: TSQLRecordClass;
  aSourceTable: TSQLTable; aDestList: TObjectList<TSQLRecord>);
var R: TSQLRecord;
    V: ^TSQLRecord;
    Row: PPUtf8Char;
    i: integer;
begin
  R := aRecordClass.Create;
  try
    R.FillPrepare(aSourceTable);
    aDestList.Count := aSourceTable.RowCount; // faster than manual Add()
    V := @aDestList.List[0];
    Row := @aSourceTable.fResults[aSourceTable.FieldCount]; // R^ points to first row of data
    for i := 1 to aSourceTable.RowCount do begin
      V^ := aRecordClass.Create; // TObjectList will free each instance
      R.fFill.Fill(pointer(Row),V^);
      Inc(Row,aSourceTable.FieldCount);
      inc(V);
    end;
  finally
    R.Free;
  end;
end;

function TSQLRest.RetrieveGenericList(Table: TSQLRecordClass; FormatSQLWhere: PUTF8Char;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): TObjectList<TSQLRecord>;
var SQL: RawUTF8;
    T: TSQLTable;
begin
  result := nil;
  if (self=nil) or (Table=nil) then
    exit;
  SQL := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  if aCustomFieldsCSV<>'' then
    T := InternalListJSON(Table,aCustomFieldsCSV,SQL) else
    T := InternalListRecordsJSON(Table,SQL);
  if T<>nil then
  try
    result := TObjectList<TSQLRecord>.Create;
    TSQLTableToObjectGenericList(Table,T,result);
  finally
    T.Free;
  end;
end;

if you want to, I did it, I added the method constructor TSQLSampleRecord.Create(const AName, AQuestion: String);

type
  /// here we declare the class containing the data
  // - it just has to inherits from TSQLRecord, and the published
  // properties will be used for the ORM (and all SQL creation)
  // - the beginning of the class name must be 'TSQL' for proper table naming
  // in client/server environnment
  TSQLSampleRecord = class(TSQLRecord)
  private
    fQuestion: RawUTF8;
    fName: RawUTF8;
    fTime: TModTime;
  public
    constructor Create(const AName, AQuestion: String); overload;
  published
    property Time: TModTime read fTime write fTime;
    property Name: RawUTF8 read fName write fName;
    property Question: RawUTF8 read fQuestion write fQuestion;
  end;

/// an easy way to create a database model for client and server
function CreateSampleModel: TSQLModel;


implementation

function CreateSampleModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLSampleRecord]);
end;

constructor TSQLSampleRecord.Create(const AName, AQuestion: String);
begin
  inherited Create;
  FName := AName;
  FQuestion := AQuestion;
end;

then in form1 (Project04Client) I added a TStringGrid, a TAdapterBindSource and a TButton, then in the Livebinginds Designer I linked StringGrid1.* with AdapterBindSource1.*

...
private
    MyPeople :TObjectList<TSQLRecord>;
....

procedure TForm1.Button1Click(Sender: TObject);
var
  LSQLSampleRecord: TSQLSampleRecord;
begin
  LSQLSampleRecord := TSQLSampleRecord.Create('John', 'Anders');
  Database.Add(LSQLSampleRecord,true);
  LSQLSampleRecord := TSQLSampleRecord.Create('toni', 'zzzz');
  Database.Add(LSQLSampleRecord,true);
  LSQLSampleRecord := TSQLSampleRecord.Create('bepi', 'xxxx');
  Database.Add(LSQLSampleRecord,true);

  MyPeople := TObjectList<TSQLRecord>.Create;

  MyPeople := Database.RetrieveGenericList(TSQLSampleRecord,'',[]);

  AdapterBindSource1.Adapter := TListBindSourceAdapter<TSQLSampleRecord>.Create(self, TObjectList<TSQLSampleRecord>(MyPeople), True);
  AdapterBindSource1.Active := true;
end;

ok now you can run the application and press the button1.

Sorry for my English, I hope to have helped you

corchi

AntonE · 2013-02-22 13:33:44

Hello, I'm just barely starting to use mORMot now...
Nice howto. Do I also need these changes for XE2 ?
If not, what would this line :

MyPeople := Database.RetrieveGenericList(TSQLSampleRecord,'',[]);

have to look like then?

corchi72 · 2013-02-22 16:40:33

This method, I added the source code. you see above

AntonE · 2013-02-22 20:21:29

Thanks!

ab, is this correct/best way (seems very 'elegant') and will you consider adding to official mORMot code?
I do not like to custom-patch libraries.

Last edited by AntonE (2013-02-22 20:23:40)

ab · 2013-02-22 20:59:44

Generic-using code could be added to the trunk, for versions of Delphi supporting it.

AntonE · 2013-02-27 13:40:06

I tried to use this in Delphi XE2 for a Firemonkey app, but it is not working as expected. In my noobness, I wrote the code below to check. First loop work as expected, 2nd loop (generic list) not, but the number of entries/objects/records(!?) are correct, they are just all 'empty'.
AntonE

procedure TForm1.BtnRouters(Sender:TObject);
var R : TSQLMikrotik;
    I : Integer;
begin
 if Assigned(Routers)
    then FreeAndNil(Routers);
 R:=TSQLMikrotik.CreateAndFillPrepare(Database, '',[]);
 try
  while R.FillOne do
   ShowMessage(IntToStr(R.ID)+' '+R.Name+' '+R.IP); (*Displays all records correctly*)
 finally
  R.Free;
 end;

 Routers := Database.RetrieveGenericList(TSQLMikrotik,'',[]);
 for I := 0 to Routers.Count-1 do
  begin
   ShowMessage('#'+IntToStr(Routers[i].ID)+' '+R.Name+' '+R.IP); (*This always shows '#0' *)
  end;

 BindScopeCollection.DataObject := Routers;
 bndlstRoutersToListbox.FillList;
 ListBox1.ItemIndex := 0;
 BindScopeForm.Active := True;
end;

Last edited by AntonE (2013-02-27 13:41:49)

ab · 2013-02-27 14:02:51

The RetrieveGenericList() implementation is certainly just broken in the above code.

AntonE · 2013-02-27 14:14:49

I just copy/pasted and reformatted it to suit my indent style(I hope):

procedure TSQLTableToObjectGenericList(aRecordClass: TSQLRecordClass; aSourceTable: TSQLTable; aDestList: TObjectList<TSQLRecord>);
var R     : TSQLRecord;
    V     : ^TSQLRecord;
    Row   : PPUtf8Char;
    i     : integer;
begin
 R := aRecordClass.Create;
 try
  R.FillPrepare(aSourceTable);
  aDestList.Count := aSourceTable.RowCount; // faster than manual Add()
  V := @aDestList.ToArray[0];
  Row := @aSourceTable.fResults[aSourceTable.FieldCount]; // R^ points to first row of data
  for i := 1 to aSourceTable.RowCount do
   begin
    V^ := aRecordClass.Create; // TObjectList will free each instance
    R.fFill.Fill(pointer(Row),V^);
    Inc(Row,aSourceTable.FieldCount);
    inc(V);
   end;
 finally
  R.Free;
 end;
end;

function TSQLRest.RetrieveGenericList(Table: TSQLRecordClass; FormatSQLWhere: PUTF8Char; const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): TObjectList<TSQLRecord>;
var SQL  : RawUTF8;
    T    : TSQLTable;
begin
  result := nil;
  if (self=nil) or (Table=nil)
     then exit;
  SQL := FormatUTF8(FormatSQLWhere,[],BoundsSQLWhere);
  if aCustomFieldsCSV<>''
     then T := InternalListJSON(Table,aCustomFieldsCSV,SQL)
     else T := InternalListRecordsJSON(Table,SQL);
  if T<>nil
     then try
           result := TObjectList<TSQLRecord>.Create;
           TSQLTableToObjectGenericList(Table,T,result);
          finally
           T.Free;
          end;
end;

AntonE · 2013-02-27 14:24:33

Above code:

   ShowMessage('#'+IntToStr(Routers[i].ID)+' '+R.Name+' '+R.IP); (*This always shows '#0' *)

should have been

ShowMessage('#'+IntToStr(Routers[i].ID)+' '+TSQLMikrotik(Routers[i]).Name+' '+TSQLMikrotik(Routers[i]).IP);

But that gives an RT error, so I supposed that invalid typecast. Then I look at declaration:

    Routers : TObjectList<TSQLRecord>;

Maybe objects are returned as TSQLrecord, not as TSQLMikrotik
But if I change it to

    Routers : TObjectList<TSQLMikrotik>;

Then I get 'Invalid type cast' compile error on.

 Routers := Database.RetrieveGenericList(TSQLMikrotik,'',[]);

Last edited by AntonE (2013-02-27 14:25:04)

ab · 2013-02-27 14:29:43

Implementation and syntax should be, I suspect, something like:

function RetrieveList<TSQLRecord>(FormatSQLWhere: PUTF8Char;
  const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): TObjectList<TSQLRecord>;

...

Routers := Database.RetrieveList<TSQLMikrotik>('',[]);

That is, use the generic type at the method name level, which can be retrieved within the implementation.

AntonE · 2013-02-27 20:44:51

Thank you very much for your help so far.
I realise that this is not a mORMot issue so I really appreciate the time.
However, I managed to compile it (interface section) by using TSQLRecordClass as in your example, instead of TSQLRecord :

function TSQLRest.RetrieveGenericList<TSQLRecordClass>(FormatSQLWhere: PUTF8Char; const BoundsSQLWhere: array of const; const aCustomFieldsCSV: RawUTF8=''): TObjectList<TSQLRecord>;

But now I do not have 'Table' variable so do not know how to access it in the function itself...
Hard enough to learn mORMot, but now generics as well.
E.g.:

...
  if aCustomFieldsCSV<>''
     then T := InternalListJSON(Table,aCustomFieldsCSV,SQL)
     else T := InternalListRecordsJSON(Table,SQL);
...

AntonE · 2013-02-28 00:26:42

I downloaded latest source to use new mORMot RetrieveList instead of patch.
My test loop is working now!

I just need to get LiveBindings to work, so it seem the generics issue is solved.
Thank you very much.

AntonE

ab · 2013-02-28 05:31:41

Great!

And do not forget to free the list after use.

AntonE · 2013-03-01 00:26:02

I have somewhat success with XE3, but I thought I'll make a wireframe mORMot + LiveBinding + Firemonkey demo for persons more knowledgeable to perhaps expand so everyone can have a good demo to sample CRUD & queries.
Included is 2 methods:
1) Using TAdapterBinding but I could not find that in XE2... Also do not know how to bi-directionally link to e.g. TEdit1
2) Clone from BOCollections Delphi demos to try and make it work with TSQLSampleRecord...

I made this project as subdir next to other Samples, so it also shares e.g. SampleData, need Sample 04 's server running to work.

You can find first version here, still very basic and broken, still needs lots of input.
ftp://ftp.true.co.za/LiveBindingsFireMonkey.zip

Regards
AntonE

Last edited by AntonE (2013-03-01 00:27:56)

ab · 2013-03-01 23:33:58

This is a good contribution.

The more samples, the better.

Thanks!

AntonE · 2013-03-02 00:04:58

I have updated the sample in link above to only include a working LiveBindings in FireMonkey with XE3. (XE2 would not work)
It has simple Grid , TEdit and TMemo to display TSQLSampleRecord with add/edit/save/cancel/delete buttons for a very simple UI.
(All is working, except I do not know how to delete correctly, still learning...)

If someone change/fix that sample extensively, please copy back to the FTP with another filename(no password needed).
Or let me know if/what changes you make (or I must make) and I can update the FTP version as well.

Regards
AntonE

ab · 2013-03-05 08:20:54

Thanks for the feedback and sample!

noobies · 2018-03-07 12:43:22

hi, AntonE sample link is broken, can u reupload sample, ty

mORMot Open Source

#1 2013-02-19 10:32:16

Example to using Livebinding with mORMot

#2 2013-02-22 13:33:44

Re: Example to using Livebinding with mORMot

#3 2013-02-22 16:40:33

Re: Example to using Livebinding with mORMot

#4 2013-02-22 20:21:29

Re: Example to using Livebinding with mORMot

#5 2013-02-22 20:59:44

Re: Example to using Livebinding with mORMot

#6 2013-02-27 13:40:06

Re: Example to using Livebinding with mORMot

#7 2013-02-27 14:02:51

Re: Example to using Livebinding with mORMot

#8 2013-02-27 14:14:49

Re: Example to using Livebinding with mORMot

#9 2013-02-27 14:24:33

Re: Example to using Livebinding with mORMot

#10 2013-02-27 14:29:43

Re: Example to using Livebinding with mORMot

#11 2013-02-27 20:44:51

Re: Example to using Livebinding with mORMot

#12 2013-02-28 00:26:42

Re: Example to using Livebinding with mORMot

#13 2013-02-28 05:31:41

Re: Example to using Livebinding with mORMot

#14 2013-03-01 00:26:02

Re: Example to using Livebinding with mORMot

#15 2013-03-01 23:33:58

Re: Example to using Livebinding with mORMot

#16 2013-03-02 00:04:58

Re: Example to using Livebinding with mORMot

#17 2013-03-05 08:20:54

Re: Example to using Livebinding with mORMot

#18 2018-03-07 12:43:22

Re: Example to using Livebinding with mORMot

Board footer