How to implement a virtual table on TMS Webcore XData Client?

How to Create a virtual table on TMS Webcore XData Client?

It is not at all obvious what has to be done to create virtual or memory tables, when using XData and TMS Webcore with Delphi. Here is a self contained unit showing how to do it.

Implementation

unit Remote.Virtual;

interface

uses
  System.SysUtils, System.Classes, JS, Web, WEBLib.Modules, Data.DB,
  WEBLib.DB, XData.Web.JsonDataset, XData.Web.Dataset;

type
  TXDS = class (TXDataWebDataSet)
  protected
    FSrc : TWebDataSource;
    procedure Add_Int_Field (const AField : string);
    procedure Add_Chr_Field (const AField : string);
    procedure Add_Str_Field (const AField  : string;
                             const ALength : integer);
    procedure Set_Data (const AData : string);
    procedure Create_Datasource;
  end;

  TVirtual = class
  private
    class var xds_Status : TXDS;
    class var xds_Yes_No : TXDS;
  public
    class function Status : TWebDataSource;
    class function Yes_No : TWebDataSource;
  end;

implementation

uses
  WEB.Common;

{ TXDS }

procedure TXDS.Add_Chr_Field (const AField : string);
var
  LField : TStringField;
begin
  LField           := TStringField.Create (Self);
  LField.FieldName := AField;
  LField.DataSet   := Self;
end;

procedure TXDS.Add_Int_Field (const AField : string);
var
  LField : TIntegerField;
begin
  LField           := TIntegerField.Create (Self);
  LField.FieldName := AField;
  LField.DataSet   := Self;
end;

procedure TXDS.Add_Str_Field (const AField  : string;
                              const ALength : integer);
var
  LField : TStringField;
begin
  LField           := TStringField.Create (Self);
  LField.Size      := ALength;
  LField.FieldName := AField;
  LField.DataSet   := Self;
end;

procedure TXDS.Set_Data (const AData : string);
begin
  SetJsonData (TJSArray(TJSJson.Parse(AData)));
end;

procedure TXDS.Create_Datasource;
begin
  FSrc := TWebDataSource.Create (Self);
  FSrc.DataSet := Self;
  if Assigned (FSrc)
  then  Console_Log ('Is Assigned');
end;

{ TVirtual }

class function TVirtual.Status : TWebDataSource;
const
  LData = '[{"Status":"A", "Name":"Active"},'+
           '{"Status":"D", "Name":"Deleted"},'+
           '{"Status":"I", "Name":"Inactive"}]';
begin
  if not assigned (xds_Status)
  then begin
       xds_Status := TXDS.Create (nil);
       xds_Status.Add_Chr_Field ('Status');
       xds_Status.Add_Str_Field ('Name', 20);
       xds_Status.Set_Data (LData);
       xds_Status.Create_Datasource;
       xds_Status.Open;
  end;
  xds_Status.FSrc.Enabled := True;
  Result := xds_Status.FSrc;
end;

class function TVirtual.Yes_No : TWebDataSource;
const
  LData = '[{"Status":"N", "Name":"No"},'+
           '{"Status":"Y", "Name":"Yes"}]';
var
  LDTS : TWebDataSource;
begin
  if not assigned (xds_Yes_No)
  then begin
       xds_Yes_No := TXDS.Create (nil);
       xds_Yes_No.Add_Str_Field ('Status', 1);
       xds_Yes_No.Add_Str_Field ('Name', 10);
       xds_Yes_No.Set_Data (LData);
       xds_Yes_No.Create_Datasource;
       xds_Yes_No.Open;
  end;
  xds_Yes_No.FSrc.Enabled := True;
  Result := xds_Yes_No.FSrc;
end;

end.
  

Explanation

1. The json data structure is very strict, dont have stray commas etc.
2. The sample shows two tables.
3. I have subclassed TXDataWebDataSet to hold some common code.
4. I don't like global procedures and functions, so the functions are held inside the class TVirtual.
5. In my usage I need a Datasource, so the functions return a datasource.

Usage

{ Both edStatus and edIs_Helicopter are "TWebDBLookupComboBoxes".
  I have populated the "KeyField" and ""ListField" in the object inspector

  For edStatus (as an example)

  - This allows me to save 'A', 'I', and 'D' in the Database
  - But the user sees 'Active', 'Inactive' and 'Deleted' in the dropdown.
}

procedure TFormExample.Prepare_For_Edit_And_Insert;
begin
  edStatus.ListSource := TVirtual.Status;
  edIs_Helicopter.ListSource := TVirtual.Yes_No;
end;

procedure FormExample_XDataWebDataSet_AfterEdit (DataSet : TDataSet);
begin
  Prepare_For_Edit_And_Insert;
end;

procedure FormExample_XDataWebDataSet_AfterInsert (DataSet : TDataSet);
begin
  Prepare_For_Edit_And_Insert;
end;

  

If you found this useful, then please consider making a donation.

Please donate if helpful