Jump to content

JohnF

Members
  • Content Count

    2
  • Joined

  • Last visited

Community Reputation

1 Neutral

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. 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.
  2. 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?
×