TDate convertion for default (0) value to empty string (livebinding)

[JohnF 1]

I'm sure this has been covered somewhere before, but I have been unable to locate a solution

 

TDate fields in an object showing the default date  (value 0.0) of 30/12/1899 when bound to a string.

 

• D11.3
• I have Objects that arebeing populated from a JSON source.
• I have several TDate fields.
• The default value set is 0 which equates to 30/12/1899.
• Using live bindings to display the objects using a TPrototypeBindSource and a TListBindSourceAdapter<myObject>

 

I would like to override the default date conversion and show an empty string. I was tTrying to have a way to convert all of the date/dateimes to string with an empty string for whatever default you want to use. Would prefer a global approach to the conversion.

 

The UI looks a bit crap with the 1899 dates where the JSON had an empty date.

 

I've looked at the TValueRefConverterFactory and overriding the Date to String converter but the it didnt work as the adapters have their own conversion functions;
 

in Data.Bind.ObjectScope;

function ConvToText(const ASource: TValue; AType: TScopeMemberType; out AResult: TValue): Boolean;
begin
  AResult := ASource.ToString;
  Result := True;
end;

Which gets called from here...

procedure TBindSourceAdapterEnumerator.GetMemberValue(const AMemberName: string; const AType: TScopeMemberType;
  const ACallback: TValueCallback);
const
  LObjectTypes: TScopeMemberTypes = [TScopeMemberType.mtObject, TScopeMemberType.mtBitmap];

var
  LMember: TObject;
  LMemberType: TScopeMemberType;
  LValue: TValue;
  LConverter: TConvertFunc;
  LResult: TValue;
begin
  LMember := FBindSourceAdapter.GetMember(AMemberName);
  if (LMember is TBindSourceAdapterField) and TBindSourceAdapterField(LMember).GetMemberType(LMemberType) then
  begin
    LConverter := Conversions[LMemberType, AType];
    LValue := TBindSourceAdapterField(LMember).GetTValue;
    Assert(@LConverter <> @ConvFail);
    if @LConverter <> @ConvNone then
    begin
      if LConverter(LValue, AType, LResult) then
        ACallback(LResult, AType)
      else
        Assert(False);
    end
    else
      ACallback(LValue, AType)
  end;
end;

But that Type declaration and code sits in the implemetation section so I cant see a way to get to it.....

 

If there was a way to alter the 

const
  Conversions: array[TScopeMemberType,TScopeMemberType] of TConvertFunc = (....);

 

that would be all you need....

 

Or is there something really basic that Im just missing here.

 

Ideas anyone? 

[Lars Fosdal 1792]

interface
uses
  REST.JsonReflect, System.RTTI;

type
  TSuppressZeroDateInterceptor = class(TJSONInterceptor)
  public
    function StringConverter(Data: TObject; Field: string): string; override;
    procedure StringReverter(Data: TObject; Field: string; Arg: string); override;
  end;

  SuppressZeroDateAttribute = class(JsonReflectAttribute)
  public
    constructor Create;
  end;

implementation

{ TSuppressZeroDateInterceptor }

function TSuppressZeroDateInterceptor.StringConverter(Data: TObject; Field: string): string;
var
  ctx: TRTTIContext;
  date: TDateTime;
begin
  date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
  if date <= 1.0 then begin
    result := EmptyStr;
  end
  else begin
    result := DateToISO8601(date, True);
  end;
end;

procedure TSuppressZeroDateInterceptor.StringReverter(Data: TObject; Field, Arg: string);
var
  ctx: TRTTIContext;
  date: TDateTime;
begin
  if Arg.IsEmpty then begin
    date := 0;
  end
  else begin
    date := ISO8601ToDate(Arg, True);
  end;
  ctx.GetType(Data.ClassType).GetField(Field).SetValue(Data, date);
end;

{ SuppressZeroDateAttribute }

constructor SuppressZeroDateAttribute.Create;
begin
  inherited Create(ctString, rtString, TSuppressZeroDateInterceptor);
end;

A trick I learned from @Uwe Raabe : Add the above code somewhere.

In your class that emits Json, add the SuppressZeroDate attribute before the Field of the property.

TMyClass = class
private
  [SuppressZeroDate]
  FDate: TDateTime
public
  property Date: TDateTime read FDate write FDate;
end;

 

[Lars Fosdal 1792]

Note - I've not tried this with TDate - but in theory it should behave the same?

[programmerdelphi2k 237]

LiveBinding allow that you create yourself "Methods / Conversors" to use in your projects:

1. Create a new package (DPK) to create your procedure, for example:

unit uMyMethodInvokable;

interface

// more info: RAD Studio HELP SYSTEM: Creating Custom LiveBindings Methods

implementation

uses
  System.SysUtils,
  System.Bindings.Methods,
  System.Bindings.EvalProtocol,
  System.Bindings.Consts,
  System.TypInfo,
  // System.Rtti,
  System.MaskUtils,
  System.DateUtils;

// function named: MakeMethod"XXXXXXXXXXX" convention LiveBinding!!!
function MyMakeMethodDateAsStringEmpty: IInvokable;
begin
  // return a "anonimous-function "Invokable" type...
  result := MakeInvokable( { }
    function(Args: TArray<IValue>): IValue
    var
      InputValue: IValue; // receive the value in "%s" passed
      InputString, OutputString: string;
    begin
      // ensure only one argument is received... not more or less!!! => "%s"  ---> not "%s, %s" etc...
      if (Length(Args) <> 1) then
        raise EEvaluatorError.Create(sFormatArgError);
      //
      // ensure that the received argument
      InputValue := Args[0];
      //
      // if not(InputValue.GetType.Kind in [tkString, tkWideString, tkWChar, tkWString]) then
      // raise EEvaluatorError.Create('Error 2: ' + sFormatExpectedStr);
      //
      // my output will be a "string" with Date text!!!
      if InputValue.GetType.Kind = tkFloat then
        begin
          OutputString := InputValue.GetValue.ToString;
          //
          if (OutputString = '30/12/1899') then
            OutputString := '';
        end
      else
        OutputString := '01/01/1981';
      //
      // return the output as "IValue", expected by LiveBinding calls!!!
      result := TValueWrapper.Create(OutputString);
    end);
end;

initialization

TBindingMethodsFactory.RegisterMethod( { AMethodDescription : TMethodDescription }
TMethodDescription.Create(             { }
  MyMakeMethodDateAsStringEmpty,       { AInvokable : IInvokable }
  'MyDateAsStringEmptyCustom',         { AID : string }
  'MyDateAsStringEmptyCustom',         { Name : string }
  'uMyMethodInvokable',                { AUnitName : string }
  true,                                { ADefaultEnabled : boolean }
  sFormatDesc,                         { ADescription : string }
  nil                                  { AFrameWorkClass : TPersistentClass }
  )                                    { }
  );

finalization

TBindingMethodsFactory.UnRegisterMethod('MyDateAsStringEmptyCustom' { AID : string } );

end.

Now, build and install the new package ... 

• "MyDateAsStringEmptyCustom" methods is avaliable for use in any project using LiveBindings, now!

now, just use it in your LiveBinding field, like this:

  Vcl.StdCtrls {} ,
  uMyMethodInvokable {my custom method}
    ;

type
  TForm1 = class(TForm)
    PrototypeBindSource1: TPrototypeBindSource;
    BtnEditRecord: TButton;
    BindingsList1: TBindingsList;
    StringGridPrototypeBindSource1: TStringGrid;
    LinkGridToDataSourcePrototypeBindSource1: TLinkGridToDataSource;
    NavigatorPrototypeBindSource1: TBindNavigator;
    Label1: TLabel;
    procedure BtnEditRecordClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BtnEditRecordClick(Sender: TObject);
var
  LDate: TArray<TDate>;
  i    : integer;
begin
  LDate := [ StrToDate('30/12/1899'), StrToDate('30/12/1900') ];
  //
  i              := random(2);
  Label1.Caption := 'Current value: ' + DateToStr(LDate[i]);
  //
  PrototypeBindSource1.DataGenerator.Edit;
  PrototypeBindSource1.DataGenerator.Fields.Items[0].SetTValue(LDate[i]);
  PrototypeBindSource1.DataGenerator.Fields.Items[1].SetTValue(LDate[i]);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  StringGridPrototypeBindSource1.DefaultColWidth := 200;
end;

     

 

 

Edited March 29, 2023 by programmerdelphi2k

[JohnF 1]

On 3/29/2023 at 5:31 AM, programmerdelphi2k said:

LiveBinding allow that you create yourself "Methods / Conversors" to use in your projects:

That was very helpful, better than the awesome documentation floating about;

 

Things I learnt. The CustomFormat property on a TPrototypeBindSource field is not used when binding to a StringGrid, If you are binding to bothat a Grid and control, set the CustomFormat on the grid as well. 

 

I wrote a couple of procedure to populate the BindSource fields and the Grid columns. A bit of inspiration/plagiarism for the binding method 🙂

 

I hope someone may find it useful.

 

Cheers

 

ps: the const I used for replacing the Date with a "blank" currently say '<Blank>' just for proof of concept/testing purposes. Please change it/anything else as required.

 

And If I have any brain farts in the code. Please let me know 🙂

 

 

unit my.System.BindUtil;

interface

uses

  System.Classes
  , System.SysUtils
  , System.Bindings.Methods
  , System.Bindings.EvalProtocol
  , System.Bindings.Consts

  , Data.Bind.Components
  , Data.Bind.Grid
  , Data.Bind.ObjectScope

  ;


{
  https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Creating_Custom_LiveBindings_Methods
}



const
  _sID_BindMethod_BlankDateToString = 'BlankDateToString';

  _sBlankDate = '<BLANK>';

  _BlankInputDate = 0;

  _FormatBlankDateToString = _sID_BindMethod_BlankDateToString +'(%s)';




Type
  TBindingUtil = Class

    /// Class Procs for setting CustomFormats for TDate properties
    ///
    /// useful for the TProtoTypeBindSource and the TAdapterBindSource
    ///
    ///  Use this to Map a Class to a Collection of FieldDef. It populates the
    ///  BindSource fields and sets the CustomFormat for and TDate Fields
    ///
    ///  TBindingUtil.MapFieldDefs(fListBindSource.FieldDefs, fImportClass);
    ///
    ///
    ///  Once the Gridlink is established if you dont want to hand populate it
    ///  and want to see all the  fields, then call this. It populates the grid
    ///  columns and sets the CustomFormat for and TDate Fields
    ///
    ///  TBindingUtil.CreateGridColumns(FGridLink, 150);
    ///

    class Procedure MapFieldDefs (FieldDefs: TGeneratorFieldDefs; AClass:TClass);

    class Procedure CreateGridColumns (Link : TLinkGridToDataSource; DefWidth: Integer = 0);

  End;


  TBindMethods = Class
    class function MethodBlankDateToString: IInvokable;
  end;



implementation

uses REST.Response.Adapter
  , System.TypInfo
  , System.Rtti
  , Data.DB
  , Data.Bind.DBScope
  ;

{ TBindingUtil }

class procedure TBindingUtil.CreateGridColumns(Link: TLinkGridToDataSource;
 DefWidth: Integer);
var
  DS: TBaseLinkingBindSource;
  GenFieldDefs: TGeneratorFieldDefs;
  FieldDefs: TFieldDefs;

  P: TPrototypeBindSource;

  GFld: TGeneratorFieldDef;

  DBFldDef: Data.DB.TFieldDef;

  Clm: TLinkGridToDataSourceColumn;
  I: Integer;
begin
  DS := Link.DataSource;
  FieldDefs := Nil;
  GenFieldDefs := Nil;

  If DS Is TPrototypeBindSource Then
    Begin
      GenFieldDefs := TPrototypeBindSource(DS).FieldDefs;
    End;

  ///
  ///
  If DS Is TAdapterBindSource Then
    begin
      if Assigned(TAdapterBindSource(DS).Adapter) then
        begin
          if TAdapterBindSource(DS).Adapter is TDataGeneratorAdapter then
            GenFieldDefs := TDataGeneratorAdapter(TAdapterBindSource(DS).Adapter).FieldDefs;
        end;
    end;

  If DS Is TBindSourceDB Then
    begin
      if Assigned(TBindSourceDB(DS).DataSet) then
        FieldDefs := TBindSourceDB(DS).DataSet.FieldDefs;
    end;

  /// Make sure we have a valid collection before we go forward
  ///
  if GenFieldDefs <> Nil then
    Begin
      Link.Columns.Clear;
      For GFld In GenFieldDefs Do
        Begin
          Clm := Link.Columns.Add;
          Clm.Header := GFld.Name;
          Clm.MemberName := GFld.Name;

          If DefWidth <> 0 Then
            Clm.Width := DefWidth
          Else
            Clm.Width := Link.DefaultColumnWidth;

          If (GFld.FieldType = TGeneratorFieldType.ftDate) Or ((GFld.FieldType = TGeneratorFieldType.ftDateTime)) Then
            Clm.CustomFormat := _FormatBlankDateToString
        End;
    End

  else if FieldDefs <> Nil then

    Begin
      Link.Columns.Clear;

      ///  For DFld In FieldDefs Do
      ///
      ///  Didnt work, for some reason FieldDef -> namedItem -> CollectionItem
      ///
      ///  Cannot be seen as a CollectionItem ?????
      ///

      for I := 0 to FieldDefs.Count-1 do
        Begin
          DBFldDef := FieldDefs[I];

          Clm := Link.Columns.Add;
          Clm.Header := DBFldDef.Name;
          Clm.MemberName := DBFldDef.Name;

          If DefWidth <> 0 Then
            Clm.Width := DefWidth
          Else
            Clm.Width := Link.DefaultColumnWidth;

          If (DBFldDef.DataType = TFieldType.ftDate) Or ((DBFldDef.DataType = TFieldType.ftDateTime)) Then
            Clm.CustomFormat := _FormatBlankDateToString
        End;
    End;


End;




class procedure TBindingUtil.MapFieldDefs(FieldDefs: TGeneratorFieldDefs;
  AClass: TClass);
var
  Ctx: TRttiContext;
  Typ: TRttiType;
  Prps: TArray<TRttiProperty>;
  I: Integer;
  Prp: TRttiProperty;
  PrpTypInfo: PTypeInfo;
  F:TGeneratorFieldDef;
  X: Integer;

begin
  if FieldDefs.Count = 0 then
    begin

      Ctx := TRttiContext.Create;
      Typ := Ctx.GetType(AClass);
      Prps := Typ.GetProperties;

      /// loop through the properties to add the fieldds to the
      ///  fielddef collection.
      ///
      For I := 0 To Length(Prps) - 1 Do
        Begin
          Prp := Prps[I];
          PrpTypInfo := Prp.PropertyType.Handle;

          ///  if the Field does not exist, Add it and then fill in the name and
          ///  read only property
          ///

          ///  Dont use FieldDefs.Find(Prp.Name) as it throws a exception if it doesnt
          ///  find anything, also it uses IndexOf anyway
          ///

          X := FieldDefs.IndexOf(Prp.Name);

          if X<0 then
            F := Nil
          else
            F := FieldDefs[I];

          if not Assigned(F) then
            begin
              F := FieldDefs.AddFieldDef;
              F.Name := Prp.Name;;
              F.ReadOnly := not Prp.IsWritable;
            end;

          ///  make sure the FieldType is set, if its a Date then set the custom format
          ///

          Case PrpTypInfo.Kind Of

            tkEnumeration, tkInteger, tkInt64:
              F.FieldType := TGeneratorFieldType.ftInteger;

            tkFloat:
              Begin
                F.FieldType := TGeneratorFieldType.ftSingle;

                If PrpTypInfo = System.TypeInfo(TDate) Then
                  Begin
                    F.FieldType := TGeneratorFieldType.ftDate;
                    F.CustomFormat := _FormatBlankDateToString;
                  End;

                If PrpTypInfo = System.TypeInfo(TTime) Then
                  Begin
                    F.FieldType := TGeneratorFieldType.ftTime;
                    F.CustomFormat := _FormatBlankDateToString;
                  End;

                If PrpTypInfo = System.TypeInfo(TDateTime) Then
                  Begin
                    F.FieldType := TGeneratorFieldType.ftDateTime;
                    F.CustomFormat := _FormatBlankDateToString;
                  End;

              End;

            tkVariant, tkChar, tkWChar, tkString, tkLString, tkWString, tkUString:
              F.FieldType := TGeneratorFieldType.ftString;

          End;

        End;

    End;
End;


{ TBindMethods }


class function TBindMethods.MethodBlankDateToString: IInvokable;
begin
  Result := MakeInvokable(
    function(Args: TArray<IValue>): IValue
    var
      InputValue: IValue;
      OutputString: String;
    begin
      // Ensure only one argument is received.
      if Length(Args) <> 1 then
        raise EEvaluatorError.Create(sFormatArgError);

      // Ensure that the received argument is a Float and of Type Date/DateTime.
      InputValue := Args[0];

      If InputValue.GetType.Kind = tkFloat Then
        Begin
          If (InputValue.GetType = System.TypeInfo(TDate)) Or (InputValue.GetType = System.TypeInfo(TDateTime)) Then
            Begin
              ///  if the value is 0 then its blank and assign the output to be the blank string
              ///  from the consts
              ///
              If InputValue.GetValue.AsExtended = 0 Then
                OutputString := _sBlankDate
              Else
                OutputString := DateToStr(InputValue.GetValue.AsExtended)
            End
          Else
            OutputString := InputValue.GetValue.ToString;
        End
      Else
        OutputString := InputValue.GetValue.ToString;

      // Return the output string.
      Result := TValueWrapper.Create(OutputString);
    End);

end;



initialization

if not TBindingMethodsFactory.HasMethod(_sID_BindMethod_BlankDateToString) then

  TBindingMethodsFactory.RegisterMethod(    { AMethodDescription : TMethodDescription }

    TMethodDescription.Create(              { }
      TBindMethods.MethodBlankDateToString, { AInvokable : IInvokable }
      _sID_BindMethod_BlankDateToString,    { AID : string }
      _sID_BindMethod_BlankDateToString,    { Name : string }
      'my.System.BindUtil',                 { AUnitName : string }
      true,                                 { ADefaultEnabled : boolean }
      sFormatDesc,                          { ADescription : string }
      nil                                   { AFrameWorkClass : TPersistentClass }
      )                                     { }
    );


finalization

  TBindingMethodsFactory.UnRegisterMethod(_sID_BindMethod_BlankDateToString);
end.

 

Edited April 3, 2023 by JohnF

[programmerdelphi2k 237]

let's try it  

[programmerdelphi2k 237]

a little fix for "OutPutString"

 

function MyMakeMethodDateAsStringEmpty: IInvokable;
var
  i: integer;
begin
  // return a "anonimous-function "Invokable" type...
  result := MakeInvokable( { }
    function(Args: TArray<IValue>): IValue
    var
      InputValue: IValue; // receive the value in "%s" passed
      InputString, OutputString: string;
    begin
      i := Length(Args);
      //
      // ensure only one argument is received... not more or less!!! => "%s"  ---> not "%s, %s" etc...
      if (i <> 1) then
        raise EEvaluatorError.Create(sFormatArgError);
      //
      // ensure that the received argument
      InputValue := Args[0];
      //
      OutputString := InputValue.GetValue.ToString; 
      //
      // my output will be a "string" with Date text!!!
      if (InputValue.GetType.Kind = tkFloat) and (OutputString = '30/12/1899') then
        OutputString := '';
      //
      // return the output as "IValue", expected by LiveBinding calls!!!
      result := TValueWrapper.Create(OutputString);
    end);
end;