(原创) Delphi中LiveBinding 绑定非数据库类数据的时候显示字段自定义名称
DELPHI默认下，Grid控件通过TAdapterBindSource绑定到一个TObjectList<TObject>列表时,Grid的Header显示的是TObject的属性名称。不能像绑定数据集时显示自定义名称，我们来看看其是怎么实现的。
Grid是如何绑定数据的，通过Grid的绑定类TLinkGridToDataSource，追踪到单元Data.Bind.Grid.pas。TCustomLinkGridToDataSource本身没什么相关的方法，其父类是TCustomLinkGridToDataSource，TCustomLinkGridToDataSource里发现了相关方法GetMemberDisplayName(),是个override方法，继承自TBaseLinkGridToDataSource,在TBaseLinkGridToDataSource中，GetMemberDisplayName()只是占位。真正实现是TCustomLinkGridToDataSource的GetMemberDisplayName(),代码:
function TCustomLinkGridToDataSource.GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean;
var
LScopeMemberDisplayNames: IScopeMemberDisplayNames;
begin
Result := Supports(GetDataSource, IScopeMemberDisplayNames, LScopeMemberDisplayNames);
if Result then
Result := LScopeMemberDisplayNames.GetMemberDisplayName(AMemberName, ADisplayName);
end;
这里可以看到，TCustomLinkGridToDataSource只是判断中转下，真正的实现取决于其DataSource属性，只有其DataSource支持了IScopeMemberDisplayNames接口并实现了GetMemberDisplayName()方法，才能实现这个功能。这个DataSource属性是什么呢？
GetDataSource() 是在TBaseLinkGridToDataSource实现的
function TBaseLinkGridToDataSource.GetDataSource: TBaseLinkingBindSource;
begin
Result := DataSource;
end;
直接返回祖先类的DataSource属性，DataSource属性在基类TBaseLinkToDataSource实现，类型是:TBaseLinkingBindSource。
TBaseLinkingBindSource在单元Data.Bind.Components.pas声明，是所有绑定源的基类：
TBaseLinkingBindSource = class(TBaseBindScopeComponent) end;
只是其父类TBaseBindScopeComponent的别名。
到这里，我们可以从另一面着手追踪，通过绑定数据集的控件TBindSourceDB和绑定非数据集TAdapterBindSource来追踪，最后都能追踪到TBaseLinkingBindSource。通过查看源码，我们可以看到TBaseLinkingBindSource的2个子类，TBaseObjectBindSource是所有非数据集控件的绑定源基类，TCustomBindSourceDB是数据集绑定控件的基类。
TAdapterBindSource的基类是TBaseObjectBindSource，在单元Data.Bind.ObjectScope.pas;
TBindSourceDB的基类是TCustomBindSourceDB，在单元Data.Bind.DBScope.pas;
TBaseObjectBindSource和TCustomBindSourceDB继承自TBaseLinkingBindSource，TBaseLinkingBindSource是TBaseBindScopeComponent别名，在单元Data.Bind.Components.pas。
IScopeMemberDisplayNames接口也在单元Data.Bind.Components.pas。
源代码:
IScopeMemberDisplayNames = interface ['{B02AADEE-2F39-4A26-A17C-5A7B391647FD}'] function GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; end;
TBaseObjectBindSource = class(TBaseLinkingBindSource, IScopeEditLink, IScopeRecordEnumerable, IScopeNavigator, IScopeState, IScopeEditor, IScopeMemberNames, IScopeCurrentRecord, IScopeActive, IScopeMemberScripting, IScopeGetRecord, IScopeLookup, IScopeNavigatorUpdates, IScopeLocate)
TCustomBindSourceDB = class(TBaseLinkingBindSource, IScopeEditLink, IScopeRecordEnumerable, IScopeRecordEnumerableBuffered, IScopeNavigator, IScopeActive, IScopeState, IScopeEditor, IScopeMemberNames, IScopeCurrentRecord, IScopeMemberScripting, IScopeGetRecord, IScopeLookup, IScopeNavigatorUpdates, IScopeBuffer, IScopeLocate, IScopeUnidirectional, IScopeMemberDisplayNames)
可以看到，TCustomBindSourceDB实现了接口IScopeMemberDisplayNames，而TBaseObjectBindSource没有。
到这里，我们基本明白了，绑定数据集时，为什么可以显示自定义名称了：一个原因是数据集域控件本身支持属性DisplayName（TField有个属性DisplayName，FD的控件里叫DiplayLable对应DB.Field里的DisplayName)；另一个原因是TBindSourceDB直接支持接口IScopeMemberDisplayNames。
TCustomBindSourceDB的GetMemberDisplayName()实现源码:
function TCustomBindSourceDB.GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; var LField: TField; begin Result := False; if FDataSource.DataSet <> nil then begin if FDataSource.DataSet.Fields.Count > 0 then begin LField := DataSource.DataSet.FindField(AMemberName); if LField <> nil then begin if LField.DisplayName <> '' then begin Result := True; ADisplayName := LField.DisplayName; end; end; end; if (not Result) and (DataSource.DataSet.AggFields.Count > 0) then begin LField := DataSource.DataSet.AggFields.FindField(AMemberName); if LField.DisplayName <> '' then begin Result := True; ADisplayName := LField.DisplayName; end; end; end; end;
就是通过数据域名 (AMemberName)找到域，然后获取DisplayName。
那么，对于非数据集数据，我们可以模拟此实现。比如当我们用ORM来操作数据库时，一般GRID绑定的数据就是 TObjectList<TEntityObject>列表。要从两个地方进行修改：
一是修改TBaseObjectBindSource，实现IScopeMemberDisplayNames；二是修改TEntityObject，对于需要自定义显示名的字段定义DisplayName。下面分别讨论。
一、修改TBaseObjectBindSource，实现IScopeMemberDisplayNames。
前面说过TBaseObjectBindSource是所有绑定非数据集数据的绑定源基类，研究源码，其继承关系是TAdapterBindSource->TCustomAdapterBindSource->TBaseObjectBindSource；另一个是TPrototypeBindSource->TCustomPrototypeBindSource->TBaseObjectBindSource，比较适合改造的肯定是TCustomAdapterBindSource和TCustomPrototypeBindSource了。先不管TCustomPrototypeBindSource，先看一般的绑定源类TCustomAdapterBindSource，我们先定义一个类：
TJkAdapterBindSource = class(TCustomAdapterBindSource, IScopeMemberDisplayNames) public function GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; end;
现在就是如何实现这个GetMemberDisplayName()了，但是发现我们无法参考TCustomBindSourceDB类的GetMemberDisplayName()实现，为什么呢？主要是因为TCustomBindSourceDB类直接包含了一个FDataSource: TDataSource字段，所以TCustomBindSourceDB类可以通过这个FDataSource来获取数据域信息。但是TBaseObjectBindSource类是没有这个属性的，联想下我们平常的使用，TCustomBindSourceDB类可以直接设置DataSource属性，TBaseObjectBindSource的子类只能是设置一个Adapter属性或者是通过OnCreateAdapter事件来获取一个Adapter，就是说，绑定到非数据集的绑定源控件，是要通过一个Adapter来绑定到非数据集数据的（Adapter就相当于TDataSource，TDataSource就是绑定数据集控件的Adapter，TDataSource只要一个，但是Adapter要有多种才能适配不同的非数据集数据）。通过研究源码，发现TBaseObjectBindSource关于数据的信息都是通过Adapter来获取的，比如GetMemberNames的实现:
procedure TBaseObjectBindSource.GetMemberNames(AList: TStrings); begin if CheckAdapter then GetInternalAdapter.GetMemberNames(AList) end;
确实是，也应当是，这才是Adapter的功能。GetInternalAdapter（）的代码:
function TBaseObjectBindSource.GetInternalAdapter: TBindSourceAdapter; begin Result := nil; end;
基类没有实现，看子类实现:
function TCustomAdapterBindSource.GetInternalAdapter: TBindSourceAdapter; begin if CheckRuntimeAdapter then Result := GetRuntimeAdapter else Result := FAdapter; if Result <> nil then ConnectAdapter(Result); end;
这里为什么要通过GetInternalAdapter()方法来获取Adapter，而不是直接用属性Adapter，TBaseObjectBindSource类的代码中有提示：
/// <remarks>Adapter my be provided by setting a property or by implementing /// the OnCreateAdapter event</remarks> TBaseObjectBindSource = class(TBaseLinkingBindSource, IScopeEditLink, IScopeRecordEnumerable, IScopeNavigator, IScopeState, IScopeEditor, IScopeMemberNames, IScopeCurrentRecord, IScopeActive, IScopeMemberScripting, IScopeGetRecord, IScopeLookup, IScopeNavigatorUpdates, IScopeLocate)
就是说，TBaseObjectBindSource的Adapter可以通过属性Adapter设置，也可以通过OnCreateAdapter()事件运行时生成（通过CheckRuntimeAdapter()、SetRuntimeAdapter()和GetRuntimeAdapter()等）
function TBaseObjectBindSource.CheckRuntimeAdapter: Boolean; var LAdapter: TBindSourceAdapter; begin if FCheckRuntimeAdapter and (FRuntimeAdapter = nil) and not (csDestroying in ComponentState) then begin FCheckRuntimeAdapter := False; Self.DoCreateAdapter(LAdapter); if LAdapter <> nil then SetRuntimeAdapter(LAdapter); end; Result := FRuntimeAdapter <> nil; end; procedure TBaseObjectBindSource.SetRuntimeAdapter(AAdapter: TBindSourceAdapter); begin SetInternalAdapter(AAdapter, procedure(AScope: TBindSourceAdapter) begin if FRuntimeAdapter <> nil then begin if not (csDestroying in FRuntimeAdapter.ComponentState) then FreeAndNil(FRuntimeAdapter); if (AAdapter = nil) and not (csDestroying in ComponentState) then // Recheck FCheckRuntimeAdapter := True; end; FRuntimeAdapter := AAdapter; if FRuntimeAdapter <> nil then begin FRuntimeAdapter.FreeNotification(Self); end; end); end; function TBaseObjectBindSource.GetRuntimeAdapter: TBindSourceAdapter; begin Result := FRuntimeAdapter; end; function TCustomAdapterBindSource.GetInternalAdapter: TBindSourceAdapter; begin if CheckRuntimeAdapter then Result := GetRuntimeAdapter else Result := FAdapter; if Result <> nil then ConnectAdapter(Result); end;
所以在获取实际运用的Adapter时，不能通过Adapter,而是用GetInternalAdapter()方法。
现在知道了，具体的GetMemberDisplayName()实现，还是在Adapter里。也就是TBindSourceAdapter类。
TBindSourceAdapter是Adapter的基类
/// <summary>Adapter base class for providing data to a TAdapterBindScope</summary> TBindSourceAdapter = class(TComponent, IBindSourceAdapter)
因为其是基类，不能在这里修改，这里修改了，相当于我们要替换掉单元Data.Bind.ObjectScope.pas，这比较麻烦，也不可取。那只能在其子类想办法了。我们实际中使用的子类主要是：TObjectBindSourceAdapter，TListBindSourceAdapter，TDataGeneratorAdapter等，TObjectBindSourceAdapter适配单个对象，TListBindSourceAdapter适用与对象列表，TDataGeneratorAdapter适用于临时产生数据。为了简单，可以以这些子类来修改。另外实现的这写子类都实现了IScopeMemberDisplayNames接口，并添加了一个私有域FDisplayNameList: TDictionary<string, string>，用于保存属性和显示名称对应值。 然后在Adapter的AddFields()方法里添加属性名称和显示名称对应值，具体的修改策略和TEntityObject如何实现DisplayName有关，这里以其中的一种策略来说明。
unit JkSoft.Bind.Utils; interface type TJkBindAttribute = class(TCustomAttribute) end; JkBindDisplayName = class(TJkBindAttribute) private FName: string; public constructor Create(const AName: string); property Name: string read FName; end; implementation { JkBindDisplayName } constructor JkBindDisplayName.Create(const AName: string); begin FName := AName; end; end.
unit JkSoft.Bind.ObjectScope; interface uses System.SysUtils, System.Classes, System.Generics.Collections, System.Rtti, System.TypInfo, Data.Bind.ObjectScope, Data.Bind.Components; type TJkObjectBindSourceAdapter<T: class> = class(TObjectBindSourceAdapter<T>, IScopeMemberDisplayNames) private FDisplayNameList: TDictionary<string, string>; protected procedure AddFields; override; procedure CreateList; public constructor Create(AOwner: TComponent; AObject: T; AOwnsObject: Boolean = True); override; destructor Destroy; override; function GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; end; TJkListBindSourceAdapter<T: class> = class(TListBindSourceAdapter<T>, IScopeMemberDisplayNames) private FDisplayNameList: TDictionary<string, string>; protected procedure AddFields; override; procedure CreateList; public constructor Create(AOwner: TComponent; AList: TList<T>; AOwnsObject: Boolean = True); override; destructor Destroy; override; function GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; end; TJkAdapterBindSource = class(TCustomAdapterBindSource, IScopeMemberDisplayNames) public function GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; end; implementation { TJkObjectBindSourceAdapter<T> } uses JkSoft.Bind.Utils; procedure TJkObjectBindSourceAdapter<T>.AddFields; var LType: TRttiType; LFields: TArray<TRttiField>; LField: TRttiField; LProps: TArray<TRttiProperty>; LProp: TRttiProperty; LAttrs: TArray<TCustomAttribute>; Lattr: TCustomAttribute; begin inherited; CreateList; LType := GetObjectType; // 规定要显示的数据域全部是Published的属性，则不用检索Field // LFields := LType.GetFields; // for LField in LFields do // begin // if LField.Visibility = TMemberVisibility.mvPublished then // begin // LAttrs := LField.GetAttributes; // for Lattr in LAttrs do // begin // if (Lattr is JkBindDisplayName) and (not JkBindDisplayName(Lattr).Name.IsEmpty) then // begin // FDisplayNameList.AddOrSetValue(LField.Name, JkBindDisplayName(Lattr).Name); // end // else if FDisplayNameList.ContainsKey(LField.Name) then // begin // FDisplayNameList.Remove(LField.Name); // end; // end; // end; // end; // // SetLength(LAttrs, 0); LProps := LType.GetProperties; for LProp in LProps do begin if LProp.Visibility = TMemberVisibility.mvPublished then begin LAttrs := LProp.GetAttributes; for Lattr in LAttrs do begin if (Lattr is JkBindDisplayName) and (not JkBindDisplayName(Lattr).Name.IsEmpty) then begin FDisplayNameList.AddOrSetValue(LProp.Name, JkBindDisplayName(Lattr).Name); end else if FDisplayNameList.ContainsKey(LProp.Name) then begin FDisplayNameList.Remove(LProp.Name); end; end; end; end; end; constructor TJkObjectBindSourceAdapter<T>.Create(AOwner: TComponent; AObject: T; AOwnsObject: Boolean); begin inherited; //FDisplayNameList := TDictionary<string, string>.Create; end; procedure TJkObjectBindSourceAdapter<T>.CreateList; begin if not Assigned(FDisplayNameList) then FDisplayNameList := TDictionary<string, string>.Create; end; destructor TJkObjectBindSourceAdapter<T>.Destroy; begin if Assigned(FDisplayNameList) then FDisplayNameList.Free; inherited; end; function TJkObjectBindSourceAdapter<T>.GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; begin Result := False; if FDisplayNameList.ContainsKey(AMemberName) and (not FDisplayNameList[AMemberName].IsEmpty) then begin Result := True; ADisplayName := FDisplayNameList[AMemberName]; end; end; { TJkListBindSourceAdapter<T> } procedure TJkListBindSourceAdapter<T>.AddFields; var LType: TRttiType; //LFields: TArray<TRttiField>; //LField: TRttiField; LProps: TArray<TRttiProperty>; LProp: TRttiProperty; LAttrs: TArray<TCustomAttribute>; Lattr: TCustomAttribute; begin inherited; CreateList; LType := GetObjectType; // 规定要显示的数据域全部是Published的属性，则不用检索Field // LFields := LType.GetFields; // for LField in LFields do // begin // if LField.Visibility = TMemberVisibility.mvPublished then // begin // LAttrs := LField.GetAttributes; // for Lattr in LAttrs do // begin // if (Lattr is JkBindDisplayName) and (not JkBindDisplayName(Lattr).Name.IsEmpty) then // begin // FDisplayNameList.AddOrSetValue(LField.Name, JkBindDisplayName(Lattr).Name); // end // else if FDisplayNameList.ContainsKey(LField.Name) then // begin // FDisplayNameList.Remove(LField.Name); // end; // end; // end; // end; // // SetLength(LAttrs, 0); LProps := LType.GetProperties; for LProp in LProps do begin if LProp.Visibility = TMemberVisibility.mvPublished then begin LAttrs := LProp.GetAttributes; for Lattr in LAttrs do begin if (Lattr is JkBindDisplayName) and (not JkBindDisplayName(Lattr).Name.IsEmpty) then begin FDisplayNameList.AddOrSetValue(LProp.Name, JkBindDisplayName(Lattr).Name); end else if FDisplayNameList.ContainsKey(LProp.Name) then begin FDisplayNameList.Remove(LProp.Name); end; end; end; end; end; constructor TJkListBindSourceAdapter<T>.Create(AOwner: TComponent; AList: TList<T>; AOwnsObject: Boolean); begin inherited; //FDisplayNameList := TDictionary<string, string>.Create; end; procedure TJkListBindSourceAdapter<T>.CreateList; begin if not Assigned(FDisplayNameList) then FDisplayNameList := TDictionary<string, string>.Create; end; destructor TJkListBindSourceAdapter<T>.Destroy; begin if Assigned(FDisplayNameList) then FDisplayNameList.Free; inherited; end; function TJkListBindSourceAdapter<T>.GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; begin Result := False; if FDisplayNameList.ContainsKey(AMemberName) and (not FDisplayNameList[AMemberName].IsEmpty) then begin Result := True; ADisplayName := FDisplayNameList[AMemberName]; end; end; { TJkAdapterBindSource } function TJkAdapterBindSource.GetMemberDisplayName(const AMemberName: string; out ADisplayName: string): Boolean; var adpInf: IScopeMemberDisplayNames; adpInternal: TBindSourceAdapter; begin Result := False; adpInternal := GetInternalAdapter; if Assigned(adpInternal) then begin if Supports(adpInternal, IScopeMemberDisplayNames, adpInf) then begin Result := adpInf.GetMemberDisplayName(AMemberName, ADisplayName); end; end; end; end.
这个实现是因为TEntityObject类的自定义显示名采用了TAttritube来实现。如果TEntityObject类的自定义显示名采用了其它的实现方法，则修改Adapter的AddFields()方法。
二、修改TEntityObject，对于需要自定义显示名的字段定义DisplayName。
TEntityObject的实现自定义显示名称的方法主要考虑下面两种策略：
1、固定设置显示名称
通过TAttritube实现，这种方法比较简单，缺点是编译时就固定了显示名称，运行时无法修改。比如：
TPerson = class private FName: string; FAge: Integer; FBirthDay: TDateTime; procedure SetAge(const Value: Integer); procedure SetBirthDay(const Value: TDateTime); procedure SetName(const Value: string); public published [JkBindDisplayName('姓名')] property Name: string read FName write SetName; [JkBindDisplayName('年龄')] property Age: Integer read FAge write SetAge; property BirthDay: TDateTime read FBirthDay write SetBirthDay; end;
2、动态设置显示名称
创建一个TEntityObject的基类TEntityBase，这个基类负责设置属性显示名称对应表
type //动态设置显示名称 TEntityBase = class(TPersistent) private class var FDisplayNameList: TDictionary<string, string>; class var FPropNameList: TStrings; class destructor UnInitialize; protected constructor Create; virtual; destructor Destroy; override; public class function GetPropNameList: TStrings; class function GetDisplayNameList: TDictionary<string, string>; class procedure SetDisplayName(const APropName, ADisplayName: string); virtual; class procedure SetDisplayNames(const ADisplayNames: TDictionary<string, string>); virtual; end; TPeople = class(TEntityBase) private FName: string; FAge: Integer; FBirthDay: TDateTime; procedure SetAge(const Value: Integer); procedure SetBirthDay(const Value: TDateTime); procedure SetName(const Value: string); published property Name: string read FName write SetName; property Age: Integer read FAge write SetAge; property BirthDay: TDateTime read FBirthDay write SetBirthDay; end; implementation uses System.TypInfo; { TEntityBase } constructor TEntityBase.Create; begin end; destructor TEntityBase.Destroy; begin inherited; end; class function TEntityBase.GetDisplayNameList: TDictionary<string, string>; begin Result := FDisplayNameList; end; class function TEntityBase.GetPropNameList: TStrings; var PropList: PPropList; Count: Integer; i: Integer; begin if not Assigned(FPropNameList) then begin FPropNameList := TStringList.Create; Count := GetPropList(Self.ClassInfo, PropList); if Count > 0 then begin for i := 0 to Count-1 do begin FPropNameList.Add(PropList[i].Name); end; end; end; Result := FPropNameList; end; class procedure TEntityBase.SetDisplayName(const APropName, ADisplayName: string); begin if not Assigned(FDisplayNameList) then FDisplayNameList := TDictionary<string, string>.Create; FDisplayNameList.AddOrSetValue(APropName, ADisplayName); end; class procedure TEntityBase.SetDisplayNames(const ADisplayNames: TDictionary<string, string>); begin if Assigned(ADisplayNames) and (ADisplayNames.Count > 0) then begin if Assigned(ADisplayNames) then FreeAndNil(FDisplayNameList); FDisplayNameList := TDictionary<string, string>.Create(ADisplayNames); end; end; class destructor TEntityBase.UnInitialize; begin if Assigned(FPropNameList) then FPropNameList.Free; if Assigned(FDisplayNameList) then FDisplayNameList.Free; end; { TPeople } procedure TPeople.SetAge(const Value: Integer); begin FAge := Value; end; procedure TPeople.SetBirthDay(const Value: TDateTime); begin FBirthDay := Value; end; procedure TPeople.SetName(const Value: string); begin FName := Value; end; initialization finalization end.
这种方法，则对应的Adapter的AddFields方法要相应修改。
procedure TJkObjectBindSourceAdapter<T>.AddFields; var LType: TRttiType; MProp: TRttiMethod; MNames: TRttiMethod; Value: TValue; begin inherited; LType := GetObjectType; MNames := LType.GetMethod(MethodGetDisplayNameList); if MNames <> nil then begin Value := MNames.Invoke(LType.AsInstance.MetaclassType, []); if (not Value.IsEmpty) and Value.IsType<TDictionary<string, string>> then begin if Assigned(FDisplayNameList) then FreeAndNil(FDisplayNameList); FDisplayNameList.Create(Value.AsType<TDictionary<string, string>>); end; end; end;
=================================================================================================================
另外：如果要自定义这个Header显示的名称，简单可以通过Grid的 OnDrawColumnHeader事件来定制,比如要修改"ID“列：
procedure TForm1.grd1DrawColumnHeader(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF); begin if Column.Header = 'ID' then Column.Header := 'ID码'; end;
