Browse Source

* Observer hook and mediator implementation added

git-svn-id: trunk@22398 -
michael 13 years ago
parent
commit
a37953dc34
3 changed files with 1476 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 2 0
      packages/fcl-base/fpmake.pp
  3. 1473 0
      packages/fcl-base/src/fpobserver.pp

+ 1 - 0
.gitattributes

@@ -1844,6 +1844,7 @@ packages/fcl-base/src/dummy/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/eventlog.pp svneol=native#text/plain
 packages/fcl-base/src/eventlog.pp svneol=native#text/plain
 packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain
 packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain
 packages/fcl-base/src/fpmimetypes.pp svneol=native#text/plain
 packages/fcl-base/src/fpmimetypes.pp svneol=native#text/plain
+packages/fcl-base/src/fpobserver.pp svneol=native#text/plain
 packages/fcl-base/src/fptemplate.pp svneol=native#text/plain
 packages/fcl-base/src/fptemplate.pp svneol=native#text/plain
 packages/fcl-base/src/fptimer.pp svneol=native#text/plain
 packages/fcl-base/src/fptimer.pp svneol=native#text/plain
 packages/fcl-base/src/gettext.pp svneol=native#text/plain
 packages/fcl-base/src/gettext.pp svneol=native#text/plain

+ 2 - 0
packages/fcl-base/fpmake.pp

@@ -38,6 +38,8 @@ begin
     T:=P.Targets.AddUnit('ascii85.pp');
     T:=P.Targets.AddUnit('ascii85.pp');
     T:=P.Targets.AddUnit('avl_tree.pp');
     T:=P.Targets.AddUnit('avl_tree.pp');
     T:=P.Targets.AddUnit('base64.pp');
     T:=P.Targets.AddUnit('base64.pp');
+    T:=P.Targets.AddUnit('fpobserver.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('blowfish.pp');
     T:=P.Targets.AddUnit('blowfish.pp');
       T.ResourceStrings:=true;
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('bufstream.pp');
     T:=P.Targets.AddUnit('bufstream.pp');

+ 1473 - 0
packages/fcl-base/src/fpobserver.pp

@@ -0,0 +1,1473 @@
+unit fpobserver;
+
+{$mode objfpc}{$H+}
+{$interfaces corba}
+
+interface
+
+uses
+  Classes, SysUtils, typinfo, contnrs;
+
+Type
+
+  TObservedHook = Class(TObject,IFPObserved)
+  Protected
+    FObservers : TFPList;
+    FSender : TObject;
+  Public
+    // ASender will be the default sender.
+    Constructor CreateSender(ASender : TObject);
+    Destructor Destroy; override;
+    Procedure FPOAttachObserver(AObserver : TObject);
+    Procedure FPODetachObserver(AObserver : TObject);
+    Procedure Changed;
+    Procedure AddItem(AItem : TObject);
+    Procedure DeleteItem(AItem : TObject);
+    Procedure CustomNotify(Data : Pointer = Nil);
+    Procedure FPONotifyObservers(ASender : TObject; AOperation : TFPObservedOperation; Data : Pointer);
+    Property Sender : TObject Read FSender;
+  end;
+
+//  EObserver = Class(Exception);
+
+
+  { TBaseMediator }
+
+  TMediatingEvent = Procedure(Sender : TObject; var Handled : Boolean) of object;
+
+  TBaseMediator = Class(TComponent,IFPObserver)
+  private
+    FActive: Boolean;
+    FOnObjectToView: TMediatingEvent;
+    FOnViewToObject: TMediatingEvent;
+    FReadOnly: Boolean;
+    FTransferring : Boolean;
+    FSubjectPropertyName: String;
+    FSubject: TObject;
+    FValueList: TObjectList;
+    FViewPropertyName: String;
+    procedure SetReadOnly(const AValue: Boolean);
+    procedure SetValueList(const AValue: TObjectList);
+    procedure SetViewPropertyName(const AValue: String); Virtual;
+  Protected
+    // Should return true (Default) if ViewPropertyName is published
+    Class Function PublishedViewProperty : Boolean; virtual;
+    // Should return true (Default) if SubjectPropertyName is published
+    Class Function PublishedSubjectProperty : Boolean; virtual;
+    // Set active. Descendents (such as list mediators) can override this.
+    procedure SetActive(const AValue: Boolean); virtual;
+    // set subject. Attaches observer and calls MaybeObjectToView
+    procedure SetSubject(const AValue: TObject); virtual;
+    // set subjectpropertyname. Checks if it exists, and calls MaybeObjectToView
+    procedure SetSubjectPropertyName(const AValue: String); virtual;
+    // Can be used in descendents to respond to onchange events
+    Procedure ViewChangedHandler(Sender : TObject);  virtual;
+    // Check if APropertyName is published property of AObject.
+    // Only performed if both parameters are not empty.
+    procedure CheckPropertyName(AObject: TObject; APropertyName: String);
+    // If all CheckObjectSubject and Active are true, call ObjectToView.
+    Procedure MaybeObjectToView;
+    // If all CheckObjectSubject and Active are true, call ViewToObject.
+    Procedure MaybeViewToObject;
+    // Check if Subject/View and property names are set up correctly.
+    Function  CheckViewSubject : Boolean;
+    // Override  next two for custom behaviour.
+    // Copies Subject.SubjectPropertyName to View.ViewPropertyName.
+    Procedure DoObjectToView; virtual;
+    // Copies View.ViewPropertyName to Subject.SubjectPropertyName
+    Procedure DoViewToObject; virtual;
+    // Override these, and call inherited at the end.
+    // Get View component. Typically a TCustomEdit instance.
+    function  GetView : TObject; virtual;
+    // Descendents should call this when the view changed.
+    procedure ViewChanged; virtual;
+    // Descendents should override this to handle changes in the value list
+    procedure ValuelistChanged; virtual;
+    // IFPObserver. Will call the necessary events.
+    Procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer);
+    // Raise an error which shows more information about the control, subject and fieldname.
+    Procedure RaiseMediatorError(Const Msg : String); overload;
+    // Format version
+    Procedure RaiseMediatorError(Const Fmt : String; Args : Array of const); overload;
+    // View property that will be set by default
+    Property ViewPropertyName : String Read FViewPropertyName Write SetViewPropertyName;
+    // Is a copy operation View <-> Subject in progress ?
+    Property Transferring : Boolean Read FTransferring;
+  Public
+    Destructor Destroy; override;
+    // Copy subject to view. No check is done to see if all is well.
+    Procedure ObjectToView;
+    // Copy view to subject. No check is done to see if all is well.
+    Procedure ViewToObject;
+    // Minimum class that View must have to be handled by this mediator.
+    class function ViewClass: TClass; virtual;
+    // Composite mediator or not ?
+    class function CompositeMediator : Boolean; virtual;
+    // Subject. Must have IFPObserved interface
+    Property Subject : TObject Read FSubject Write SetSubject;
+    // View. Must have ViewPropertyName, if in use.
+    Property View : TObject Read GetView;
+    // Value list. To be used in mediators that use a dynamical value list
+    // such as Listbox, combobox, groupbox.
+    Property Valuelist : TObjectList Read FValueList Write SetValueList;
+  Published
+    // Property that will be copied to view.
+    Property SubjectPropertyName : String Read FSubjectPropertyName Write SetSubjectPropertyName;
+    // If not active, no copying is being done either way.
+    Property Active : Boolean Read FActive Write SetActive;
+    // If ReadOnly, only ObjectToView is used
+    Property ReadOnly : Boolean Read FReadOnly Write SetReadOnly;
+    // Can be used to copy data from control (view) to subject manually
+    Property OnViewToObject : TMediatingEvent Read FOnViewToObject Write FOnViewToObject;
+    // Can be used to copy data from control (view) to subject manually
+    Property OnObjectToView : TMediatingEvent Read FOnObjectToView Write FOnObjectToView;
+  end;
+  TMediatorClass = Class of TBaseMediator;
+
+  // Forward definitions
+  TBaseListMediator = Class;
+
+  { TComponentMediator }
+  { General-purpose of Mediating views. Can be used on any form/component }
+
+  TComponentMediator = Class(TBaseMediator)
+    FViewComponent : TComponent;
+  Protected
+    function  GetView : TObject; override;
+    procedure SetComponent(const AValue: TComponent);
+  Public
+    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
+    Procedure ViewChangedHandler(Sender : TObject); override;
+  Published
+    // General component which can be set in Object Inspector
+    Property ViewComponent : TComponent Read FViewComponent Write SetComponent;
+    // Punlish property so it can be set in Object Inspector
+    Property ViewPropertyName;
+  end;
+
+  { Event object used for OnBeforeSetupField event. Is used to allow formatting
+    of fields before written to listview Caption or Items. }
+  TOnBeforeSetupField = procedure(AObject: TObject; const AFieldName: string; var AValue: string) of object;
+
+  { TListItemMediator }
+
+  TListItemMediator = class(TObject, IFPObserver)
+  private
+    FSubject: TObject;
+    FOnBeforeSetupField: TOnBeforeSetupField;
+    FListMediator : TBaseListMediator;
+    Function GetActive : Boolean;
+  protected
+    procedure SetSubject(const AValue: TObject); virtual;
+    Procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer); virtual;
+    Procedure ObjectToView; virtual;
+    Procedure ViewToObject; virtual;
+  public
+    destructor Destroy; override;
+    procedure MaybeObjectToView;
+    property OnBeforeSetupField: TOnBeforeSetupField read FOnBeforeSetupField write FOnBeforeSetupField;
+    property Subject : TObject read FSubject write SetSubject;
+    property Active : Boolean read GetActive;
+  end;
+
+  { TBaseListMediator - Base mediator that handles lists of objects.
+
+    Needs a TList as subject. Items in list must have IFPObserved
+    interface. It will create one (and use as subject) if passed a normal
+    list or a collection.
+  }
+
+  TBaseListMediator = class(TBaseMediator)
+  private
+    FOnBeforeSetupField: TOnBeforeSetupField;
+    FMediatorList: TFPObjectList;
+    FListChanged : Boolean;
+    procedure SetOnBeforeSetupField(const Value: TOnBeforeSetupField);
+  protected
+    // This needs to return false
+    Class Function PublishedViewProperty : Boolean; override;
+    // Descendents can override;
+    Function AddObject(AObject: TObject; AIndex: Integer) : TListItemMediator; virtual;
+    // Set all descendents to active
+    procedure SetActive(const AValue: Boolean); override;
+    // Must be overridden in descendents, and should return selected object
+    function GetSelectedObject: TObject; virtual;
+    // Must be overridden in descendents, and should set selected object
+    procedure SetSelectedObject(const AValue: TObject); virtual;
+    // Must be overridden in descendents to create an item mediator and add it to GUI control
+    // Subject will be set after this call.
+    Function CreateItemMediator(AData: TObject; ARow : integer) : TListItemMediator; virtual; abstract;
+    // This frees the mediator. Descendents can override to additionally update the GUI control
+    procedure DoDeleteItemMediator(AIndex : Integer; AMediator : TListItemMediator); virtual;
+    // Creates a mediator for all items in the list. List Item Mediators are re-used (subject is set)
+    procedure CreateSubMediators; virtual;
+    // Does nothing
+    procedure DoViewToObject; override;
+    // Calls CreateSubMediators. Override for additional GUI setup.
+    procedure DoObjectToView; override;
+    // Additional checks on subject.
+    procedure SetSubject(const AValue: TObject); override;
+
+    Function FindObjectMediator(AObject : TObject; out AtIndex : Integer) : TListItemMediator;
+    property MediatorList: TFPObjectList read FMediatorList;
+  public
+    constructor Create(AOwner : TComponent); override;
+    destructor Destroy; override;
+    class function CompositeMediator: Boolean; override;
+    // This should handle additional additem/deleteitem events
+    Procedure ObservedChanged(ASender : TObject; Operation : TFPObservedOperation);
+    // Selected item in the list.
+    property SelectedObject: TObject read GetSelectedObject write SetSelectedObject;
+  published
+    // Event to setup fields in item mediators.
+    property OnBeforeSetupField: TOnBeforeSetupField read FOnBeforeSetupField write SetOnBeforeSetupField;
+  end;
+
+  { TMediatorFieldInfo - Describe a column in a columnar list display }
+
+  TMediatorFieldInfo = class(TCollectionItem)
+  private
+    FWidth: integer;
+    FCaption: string;
+    FPropName: string;
+    FAlign: TAlignment;
+    function GetCaption: string;
+    procedure SetAlign(const AValue: TAlignment);
+    procedure SetCaption(const AValue: string);
+    procedure SetPropName(const AValue: string);
+    procedure SetWidth(const AValue: Integer);
+  protected
+    function GetAsString: string; virtual;
+    procedure SetAsString(const AValue: string); virtual;
+    Procedure Change;
+  public
+    procedure Assign(Source: TPersistent); override;
+    // Setting this will parse everything.
+    property AsString: string read GetAsString write SetAsString;
+  published
+    // Property Caption to be used for column head.
+    property Caption: string read GetCaption write SetCaption;
+    // Property Name to be displayed in column
+    property PropertyName: string read FPropName write SetPropName;
+    // Width of column
+    property Width: Integer read FWidth write SetWidth;
+    // Alignment of column
+    property Alignment: TAlignment read FAlign write SetAlign default taLeftJustify;
+  end;
+
+  TColumnsListMediator = Class;
+
+  { TMediatorFieldInfoList - Collection describing the columns in a columnar list display }
+
+  TMediatorFieldInfoList = class(TCollection)
+  private
+    FMediator : TColumnsListMediator;
+    function GetAsString: string;
+    function GetI(Index: integer): TMediatorFieldInfo;
+    procedure SetI(Index: integer; const AValue: TMediatorFieldInfo);
+  protected
+    procedure Notify(Item: TCollectionItem;Action: TCollectionNotification); override;
+    Property Mediator : TColumnsListMediator read FMediator;
+  public
+    // Adding items to the collection.
+    function AddFieldInfo: TMediatorFieldInfo; overload;
+    function AddFieldInfo (Const APropName : String; AFieldWidth : Integer) : TMediatorFieldInfo; overload;
+    function AddFieldInfo (Const APropName,ACaption : String; AFieldWidth : Integer) : TMediatorFieldInfo; overload;
+    function AddFieldInfo (Const APropName,ACaption : String; AFieldWidth : Integer; AAlignment : TAlignment) : TMediatorFieldInfo; overload;
+    property FieldInfo[Index: integer]: TMediatorFieldInfo read GetI write SetI; default;
+    property AsString: string read GetAsString;
+  end;
+
+  { TColumnsListItemMediator - List item mediator that can handle multiple columns }
+
+  TColumnsListItemMediator = class(TListItemMediator)
+  Private
+    Function GetFieldsInfo: TMediatorFieldInfoList;
+  Published
+    property FieldsInfo: TMediatorFieldInfoList read GetFieldsInfo;
+  end;
+
+  { TColumnsListMediator - List mediator that handles multiple columns }
+
+  TColumnsListMediator = class(TBaseListMediator)
+  Private
+    FFieldsInfo: TMediatorFieldInfoList;
+    procedure SetFieldsInfo(const AValue: TMediatorFieldInfoList);
+    function GetDisplayNames: string;
+    procedure SetDisplayNames(const AValue: string);
+    procedure FieldInfoChanged(Item: TMediatorFieldInfo; Action: TCollectionNotification); virtual;
+  Protected
+    Class Function PublishedSubjectProperty : Boolean; override;
+    procedure ParseDisplayNames(const AValue: string);
+    // Called by DoViewToObject prior to creating item mediators
+    procedure CreateColumns; virtual;
+    // Calls CreateColumns and CreateSubMediators. Override for additional GUI setup.
+    procedure DoObjectToView; override;
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    // Can be used to set the column properties in 1 statement.
+    property DisplayNames: string read GetDisplayNames write SetDisplayNames;
+  Published
+    // How to display the columns in the list.
+    property FieldsInfo: TMediatorFieldInfoList read FFieldsInfo write SetFieldsInfo;
+  end;
+
+  { TMediatorDef - Mediator Definition Storage for MediatorManager }
+
+  TMediatorDef = class(TCollectionItem)
+  private
+    FMC: TMediatorClass;
+    FMSC: TClass;
+    FPN: string;
+    FPT: TTypeKinds;
+  public
+    // Return True if this definition handles the Subject,Gui,APropinfo trio
+    function Handles(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): Boolean;
+    // Return True if this definition matches 'closer' than M.
+    // Note that both current and M must have Handles() returned true for this to be useful.
+    function BetterMatch(M: TMediatorDef): Boolean;
+    // Definition
+    property MediatorClass: TMediatorClass read FMC write FMC;
+    property MinSubjectClass: TClass read FMSC write FMSC;
+    property PropertyTypes: TTypeKinds read FPT write FPT;
+    property PropertyName: string read FPN write FPN;
+  end;
+
+
+  TMediatorDefs = class(TCollection)
+  private
+    function GetDef(Index: integer): TMediatorDef;
+    procedure SetDef(Index: integer; const AValue: TMediatorDef);
+  public
+    function AddDef: TMediatorDef;
+    property Defs[Index: integer]: TMediatorDef read GetDef write SetDef; default;
+  end;
+
+
+  TMediatorManager = class(TObject)
+  private
+    FDefs: TMediatorDefs;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // If APropName is empty or APropInfo is Nil, a composite mediator will be searched.
+    function FindDefFor(ASubject: TObject; AGui: TComponent): TMediatorDef; overload;
+    function FindDefFor(ASubject: TObject; AGui: TComponent; APropName: string): TMediatorDef; overload;
+    function FindDefFor(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): TMediatorDef; overload;
+    function RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass): TMediatorDef; overload;
+    function RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass; PropertyName: string): TMediatorDef; overload;
+    function RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass; PropertyTypes: TTypeKinds): TMediatorDef; overload;
+    property Defs: TMediatorDefs read FDefs;
+  end;
+
+  EMediator = class(Exception);
+
+function MediatorManager: TMediatorManager;
+Procedure MediatorError(Sender : TObject; Const Msg : String); overload;
+Procedure MediatorError(Sender : TObject; Fmt : String; Args : Array of const); overload;
+
+implementation
+
+
+Resourcestring
+  SErrNotObserver = 'Instance of class %s is not an observer.';
+  SErrInvalidPropertyName = '%s is not a valid published property of class %s';
+  SErrObjectCannotBeObserved = 'Cannot observe an instance of class %d';
+  sErrInvalidFieldName      = 'No fieldname specified for column %d';
+  sErrInvalidAlignmentChar  = 'Invalid alignment character "%s" specified for column %d';
+  sErrInvalidWidthSpecifier = 'Invalid with "%s" specified for column %d';
+  sErrNotListObject         = '%s is not a TObjectList';
+  sErrCompositeNeedsList    = '%s needs a TObjectList class but is registered with %s';
+  SErrActive                = 'Operation not allowed while the mediator is active';
+  SErrNoGuiFieldName        = 'no gui fieldname set';
+  SErrNoSubjectFieldName    = 'no subject fieldname set';
+
+{ ---------------------------------------------------------------------
+  Mediator global routines
+  ---------------------------------------------------------------------}
+
+Procedure MediatorError(Sender : TObject; Const Msg : String); overload;
+
+Var
+  M : TBaseMediator;
+  C : TComponent;
+  V,S : TObject;
+  CN,SN,Err : String;
+
+begin
+  if (Sender=Nil) then
+    Err:=Msg
+  else If Sender is TBaseMediator then
+    begin
+    M:=Sender as TBaseMediator;
+    V:=M.View;
+    S:=M.Subject;
+    CN:='';
+    If Assigned(V) then
+      begin
+      if (V is TComponent) then
+        begin
+        C:=TComponent(V);
+        CN:=C.Name;
+        end;
+      If (CN='') then
+        CN:=C.ClassName+' instance';
+      end
+    else
+      CN:='Nil';
+    If Assigned(S) then
+      SN:=S.ClassName
+    else
+      SN:='Nil';
+    Err:=Format('Mediator %s (%s,%s,%s) : %s',[M.ClassName,SN,CN,M.SubjectPropertyName,Msg]);
+    end
+  else if (Sender is TComponent) and (TComponent(Sender).Name<>'') then
+    Err:=Format('%s : %s',[TComponent(Sender).Name,Msg])
+  else
+    Err:=Format('%s : %s',[Sender.ClassName,Msg]);
+  Raise EMediator.Create(Err);
+end;
+
+Procedure MediatorError(Sender : TObject; Fmt : String; Args : Array of const); overload;
+
+begin
+  MediatorError(Sender,Format(Fmt,Args));
+end;
+
+Var
+  MM : TMediatorManager;
+
+function MediatorManager: TMediatorManager;
+begin
+  if (MM = nil) then
+    MM := TMediatorManager.Create;
+  Result := MM;
+end;
+
+{ TObservedHook }
+
+constructor TObservedHook.CreateSender(ASender: TObject);
+begin
+  FSender:=ASender;
+  If FSender=Nil then
+    FSender:=Self;
+end;
+
+destructor TObservedHook.Destroy;
+begin
+  If Assigned(FObservers) then
+    begin
+    FPONotifyObservers(FSender,ooFree,Nil);
+    FreeAndNil(FObservers);
+    end;
+  inherited Destroy;
+end;
+
+procedure TObservedHook.FPOAttachObserver(AObserver: TObject);
+
+Var
+  I : IFPObserver;
+
+begin
+  If Not AObserver.GetInterface(SGUIDObserver,I) then
+    Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+  If not Assigned(FObservers) then
+    FObservers:=TFPList.Create;
+  FObservers.Add(AObserver);
+end;
+
+procedure TObservedHook.FPODetachObserver(AObserver: TObject);
+
+Var
+  I : IFPObserver;
+
+begin
+  If Not AObserver.GetInterface(SGUIDObserver,I) then
+    Raise EObserver.CreateFmt(SErrNotObserver,[AObserver.ClassName]);
+  If Assigned(FObservers) then
+    begin
+    FObservers.Remove(AObserver);
+    If (FObservers.Count=0) then
+      FreeAndNil(FObservers);
+    end;
+end;
+
+procedure TObservedHook.Changed;
+begin
+  FPONotifyObservers(Sender,ooChange,Nil)
+end;
+
+procedure TObservedHook.AddItem(AItem: TObject);
+begin
+  FPONotifyObservers(FSender,ooAddItem,AItem);
+end;
+
+procedure TObservedHook.DeleteItem(AItem: TObject);
+begin
+  FPONotifyObservers(FSender,ooDeleteItem,AItem);
+end;
+
+procedure TObservedHook.CustomNotify(Data : Pointer = Nil);
+begin
+  FPONotifyObservers(FSender,ooCustom,Data);
+end;
+
+procedure TObservedHook.FPONotifyObservers(ASender: TObject;  AOperation: TFPObservedOperation; Data : Pointer);
+
+Var
+  O : TObject;
+  I : Integer;
+  Obs : IFPObserver;
+
+begin
+  If Assigned(FObservers) then
+    For I:=FObservers.Count-1 downto 0 do
+      begin
+      O:=TObject(FObservers[i]);
+      If O.GetInterface(SGUIDObserver,Obs) then
+        Obs.FPOObservedChanged(ASender,AOperation,Data);
+      end;
+end;
+
+{ TBaseMediator }
+
+function TBaseMediator.GetView: TObject;
+begin
+  Result:=Nil;
+end;
+
+procedure TBaseMediator.ViewChanged;
+begin
+  If PublishedViewProperty then
+    CheckPropertyName(View,ViewPropertyName);
+  MaybeObjectToView
+end;
+
+procedure TBaseMediator.ValuelistChanged;
+begin
+  // Do nothing
+end;
+
+procedure TBaseMediator.SetActive(const AValue: Boolean);
+begin
+  if FActive=AValue then exit;
+  FActive:=AValue;
+  MaybeObjectToView;
+end;
+
+procedure TBaseMediator.SetReadOnly(const AValue: Boolean);
+begin
+  if FReadOnly=AValue then exit;
+  FReadOnly:=AValue;
+  MaybeObjectToView;
+end;
+
+procedure TBaseMediator.SetValueList(const AValue: TObjectList);
+
+Var
+  I : IFPObserved;
+
+begin
+  if FValueList=AValue then exit;
+  If FValueList<>Nil then
+      I.FPODetachObserver(Self);
+  If Assigned(AValue) then
+    begin
+    FValueList:=AValue;
+    If Assigned(AValue) then
+      AValue.FPOAttachObserver(Self);
+    end;
+  FValueList:=AValue;
+  ValueListChanged;
+end;
+
+procedure TBaseMediator.CheckPropertyName(AObject : TObject; APropertyName : String);
+
+begin
+  If Assigned(AObject) and (APropertyName<>'') then
+    If Not IsPublishedProp(AObject,APropertyName) then
+      Raise EObserver.CreateFmt(SErrInvalidPropertyName,[APropertyName,AObject.ClassName]);
+end;
+
+procedure TBaseMediator.MaybeObjectToView;
+begin
+  If FActive and CheckViewSubject then
+    ObjectToView
+end;
+
+procedure TBaseMediator.MaybeViewToObject;
+begin
+  If FActive and (Not ReadOnly) and CheckViewSubject then
+    ViewToObject;
+end;
+
+function TBaseMediator.CheckViewSubject: Boolean;
+
+Var
+  O : TObject;
+
+begin
+  O:=GetView;
+  Result:=Assigned(FSubject)
+          and Assigned(O)
+          and (ViewPropertyName<>'')
+          and (SubjectPropertyName<>'');
+end;
+
+procedure TBaseMediator.SetSubjectPropertyName(const AValue: String);
+
+begin
+  if FSubjectPropertyName=AValue then exit;
+  If PublishedSubjectProperty then
+    CheckPropertyName(FSubject,AValue);
+  FSubjectPropertyName:=AValue;
+  MaybeObjectToView;
+end;
+
+
+procedure TBaseMediator.SetSubject(const AValue: TObject);
+
+Var
+  I : IFPObserved;
+
+begin
+  if FSubject=AValue then exit;
+  If PublishedSubjectProperty then
+    CheckPropertyName(AValue,FSubjectPropertyName);
+  If FSubject<>Nil then
+    If FSubject.GetInterface(SGUIDObserved,I) then
+      I.FPODetachObserver(Self);
+  If (AValue<>Nil) then
+    begin
+    If not AValue.GetInterface(SGUIDObserved,I) then
+      Raise EObserver.CreateFmt(SErrObjectCannotBeObserved,[AValue.ClassName]);
+    FSubject:=AValue;
+    I.FPOAttachObserver(Self);
+    end
+  else
+    FSubject:=AValue;
+  MaybeObjectToView;
+end;
+
+procedure TBaseMediator.SetViewPropertyName(const AValue: String);
+begin
+  if FViewPropertyName=AValue then exit;
+  If PublishedViewProperty then
+    CheckPropertyName(GetView,AValue);
+  FViewPropertyName:=AValue;
+  MaybeObjectToView;
+end;
+
+class function TBaseMediator.PublishedViewProperty: Boolean;
+begin
+  Result:=True;
+end;
+
+class function TBaseMediator.PublishedSubjectProperty: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TBaseMediator.ViewChangedHandler(Sender: TObject);
+begin
+  MaybeViewToObject;
+end;
+
+
+procedure TBaseMediator.FPOObservedChanged(ASender: TObject;
+  Operation: TFPObservedOperation; Data : Pointer);
+
+
+begin
+  If (ASender=FSubject) then
+    begin
+    If Operation=ooChange then
+      MaybeObjectToView
+    else if Operation=ooFree then
+      FSubject:=Nil;
+    end
+  else if (ASender=FValueList) then
+    begin
+    If Operation=ooChange then
+      ValueListChanged
+    else if Operation=ooFree then
+      FValueList:=Nil;
+    end;
+end;
+
+procedure TBaseMediator.RaiseMediatorError(const Msg: String);
+begin
+  MediatorError(Self,Msg);
+end;
+
+procedure TBaseMediator.RaiseMediatorError(const Fmt: String;
+  Args: array of const);
+begin
+  RaiseMediatorError(Format(FMT,Args));
+end;
+
+destructor TBaseMediator.Destroy;
+begin
+  Subject:=Nil;
+  ValueList:=Nil;
+  inherited Destroy;
+end;
+
+procedure TBaseMediator.DoObjectToView;
+
+begin
+  SetPropValue(GetView,ViewPropertyName,GetPropValue(FSubject,FSubjectPropertyName));
+end;
+
+procedure TBaseMediator.DoViewToObject;
+
+begin
+  SetPropValue(FSubject,FSubjectPropertyName,GetPropValue(GetView,ViewPropertyName));
+end;
+
+procedure TBaseMediator.ObjectToView;
+
+Var
+  B : Boolean;
+
+begin
+  If Not FTransferring then
+    begin
+    FTransferring:=True;
+    try
+      B:=False;
+      If Assigned(FOnObjectToView) then
+        FOnObjectToView(Self,B);
+      If not B then
+        DoObjectToView;
+    finally
+      FTransferring:=False;
+    end;
+    end;
+end;
+
+procedure TBaseMediator.ViewToObject;
+
+Var
+  B : Boolean;
+
+begin
+  If Not FTransferring then
+    begin
+    FTransferring:=True;
+    try
+      B:=False;
+      If Assigned(FONViewToObject) then
+        FONViewToObject(Self,B);
+      If not B then
+      DoViewToObject;
+    finally
+      FTransferring:=False;
+    end;
+    end;
+end;
+
+class function TBaseMediator.ViewClass: TClass;
+begin
+  Result:=TObject;
+end;
+
+class function TBaseMediator.CompositeMediator: Boolean;
+begin
+  Result:=False;
+end;
+
+{ TComponentMediator }
+
+function TComponentMediator.GetView: TObject;
+begin
+  Result:=FViewComponent;
+end;
+
+procedure TComponentMediator.SetComponent(const AValue: TComponent);
+begin
+  If (Avalue=FViewComponent) then
+    Exit;
+  If Assigned(FViewComponent) then
+    FViewComponent.RemoveFreeNotification(Self);
+  FViewComponent:=AValue;
+  If Assigned(FViewComponent) then
+    FViewComponent.FreeNotification(Self);
+  ViewChanged;
+end;
+
+procedure TComponentMediator.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  If (Operation=opRemove) and (AComponent=FViewComponent) then
+    begin
+    FViewComponent:=Nil;
+    ViewChanged;
+    end;
+end;
+
+procedure TComponentMediator.ViewChangedHandler(Sender: TObject);
+begin
+  inherited ViewChangedHandler(Sender);
+end;
+
+{ TMediatorDef }
+
+function TMediatorDef.Handles(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): Boolean;
+var
+  N: string;
+begin
+  if (APropInfo = nil) then
+    Result := FMC.CompositeMediator
+  else
+  begin
+    N      := APropInfo^.Name;
+    Result := True;
+  end;
+  if not Result then
+    Exit; // ==>
+  // At least the classes must match
+  Result := AGui.InheritsFrom(FMC.ViewClass) and ASubject.InheritsFrom(FMSC);
+  if Result and not FMC.CompositeMediator then
+    if (PropertyName <> '') then
+      Result := (CompareText(N, PropertyName) = 0)
+    else // Property kind should match. Note that property MUST be set to something.
+      Result := (APropInfo^.PropType^.Kind in PropertyTypes); // If PropertyName is set, it must match
+end;
+
+function TMediatorDef.BetterMatch(M: TMediatorDef): Boolean;
+begin
+  Result := (M = nil);
+  if not Result then
+  begin
+    Result := (FMC.CompositeMediator = M.MediatorClass.CompositeMediator);
+    if Result then
+    begin
+      Result := (PropertyName <> '') and (M.PropertyName = '');
+      if not Result then
+      begin
+        // M's property matches closer
+        Result := not ((M.PropertyName <> '') and (PropertyName = ''));
+        if Result then
+        begin
+          // Properties are on equal level. Check GUI class.
+          // Closer GUI class ?
+          Result := FMC.ViewClass.InheritsFrom(M.MediatorClass.ViewClass);
+          if not Result then
+          begin
+            // M's GUI class matches closer ?
+            Result := not (M.MediatorClass.ViewClass.InheritsFrom(FMC.ViewClass));
+            if Result then
+            begin
+              // GUI classes are on equal level (different branches in tree). Check subject class.
+              // Closer Subject class ?
+              Result := FMSC.InheritsFrom(M.FMSC);
+              if not Result then
+                // M's subject class matches closer ?
+                Result := not M.FMSC.InheritsFrom(FMSC);
+            end;
+          end;
+        end;
+      end;
+    end;
+  end;
+end;
+
+{ TMediatorDefs }
+
+function TMediatorDefs.GetDef(Index: integer): TMediatorDef;
+begin
+  Result := TMediatorDef(Items[Index]);
+end;
+
+procedure TMediatorDefs.SetDef(Index: integer; const AValue: TMediatorDef);
+begin
+  Items[Index] := AValue;
+end;
+
+function TMediatorDefs.AddDef: TMediatorDef;
+begin
+  Result := Add as TMediatorDef;
+end;
+
+{ TMediatorManager }
+
+constructor TMediatorManager.Create;
+begin
+  FDefs := TMediatorDefs.Create(TMediatorDef);
+end;
+
+destructor TMediatorManager.Destroy;
+begin
+  FreeAndNil(FDefs);
+  inherited Destroy;
+end;
+
+function TMediatorManager.FindDefFor(ASubject: TObject; AGui: TComponent): TMediatorDef;
+begin
+  Result := FindDefFor(ASubject, AGUI, PPropInfo(nil));
+end;
+
+function TMediatorManager.FindDefFor(ASubject: TObject; AGui: TComponent; APropName: string): TMediatorDef;
+var
+  propinfo: PPropInfo;
+begin
+  propinfo := GetPropInfo(ASubject, APropName);
+  Result := FindDefFor(ASubject, AGUI, propinfo);
+end;
+
+function TMediatorManager.FindDefFor(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): TMediatorDef;
+var
+  D: TMediatorDef;
+  I: integer;
+begin
+  Result := nil;
+  for I := 0 to FDefs.Count - 1 do
+  begin
+    D := FDefs[I];
+    if D.Handles(ASubject, AGUI, APropInfo) then
+      if (D.BetterMatch(Result)) then
+        Result := D;
+  end;
+end;
+
+function TMediatorManager.RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass): TMediatorDef;
+
+begin
+  Result      := FDefs.AddDef;
+  Result.MediatorClass := MediatorClass;
+  Result.FMSC := MinSubjectClass;
+  Result.FPN  := '';
+  Result.FPT  := tkProperties - [tkClass, tkInterface, tkDynArray, tkObject, tkInterfaceRaw];
+end;
+
+function TMediatorManager.RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass; PropertyName: string): TMediatorDef;
+
+begin
+  Result      := FDefs.AddDef;
+  Result.MediatorClass := MediatorClass;
+  Result.FMSC := MinSubjectClass;
+  Result.FPN  := PropertyName;
+  Result.FPT  := [];
+end;
+
+function TMediatorManager.RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass; PropertyTypes: TTypeKinds): TMediatorDef;
+
+begin
+  Result      := FDefs.AddDef;
+  Result.MediatorClass := MediatorClass;
+  Result.FMSC := MinSubjectClass;
+  Result.FPN  := '';
+  Result.FPT  := PropertyTypes;
+end;
+
+{ TListItemMediator }
+
+
+function TListItemMediator.GetActive: Boolean;
+begin
+  Result:=False;
+  If Assigned(FListMediator) then
+    Result:=FListMediator.Active;
+end;
+
+procedure TListItemMediator.SetSubject(const AValue: TObject);
+
+Var
+  I : IFPObserved;
+
+begin
+  if Avalue=FSubject then
+    Exit;
+  If FSubject<>Nil then
+    If FSubject.GetInterface(SGUIDObserved,I) then
+      I.FPODetachObserver(Self);
+  FSubject:=AValue;
+  If (FSubject<>Nil) then
+    begin
+    If not FSubject.GetInterface(SGUIDObserved,I) then
+      Raise EObserver.CreateFmt(SErrObjectCannotBeObserved,[FSubject.ClassName]);
+    I.FPOAttachObserver(Self);
+    end;
+  MaybeObjectToView
+end;
+
+procedure TListItemMediator.FPOObservedChanged(ASender: TObject;
+  Operation: TFPObservedOperation; Data : Pointer);
+begin
+  If Operation=ooFree then
+    FSubject:=Nil
+  else
+    MaybeObjectToView;
+end;
+
+procedure TListItemMediator.ObjectToView;
+begin
+  // Do nothing
+end;
+
+procedure TListItemMediator.ViewToObject;
+begin
+  // Do nothing
+end;
+
+destructor TListItemMediator.Destroy;
+begin
+  Subject:=Nil;
+  inherited Destroy;
+end;
+
+procedure TListItemMediator.MaybeObjectToView;
+begin
+  If Assigned(FSubject) and Active then
+    ObjectToView;
+end;
+
+{ TMediatorFieldInfo }
+
+procedure TMediatorFieldInfo.Change;
+
+begin
+  FPONotifyObservers(Self,ooChange,Nil);
+end;
+
+function TMediatorFieldInfo.GetCaption: string;
+begin
+  Result:=FCaption;
+  If (Result='') then
+    Result:=FPropName;
+end;
+
+procedure TMediatorFieldInfo.SetAlign(const AValue: TAlignment);
+begin
+  If AValue=fAlign then Exit;
+  FAlign:=AValue;
+  Change;
+end;
+
+procedure TMediatorFieldInfo.SetCaption(const AValue: string);
+begin
+  If AValue=Caption then Exit;
+  FCaption:=AValue;
+  Change;
+end;
+
+procedure TMediatorFieldInfo.SetPropName(const AValue: string);
+begin
+  If AValue=FPropName then Exit;
+  FPropName:=AValue;
+  Change;
+end;
+
+procedure TMediatorFieldInfo.SetWidth(const AValue: Integer);
+begin
+  If (FWidth=AValue) then Exit;
+  FWidth:=AValue;
+  Change;
+end;
+
+const
+  AlignChars: array[TAlignMent] of char     = ('l', 'r', 'c');
+
+function TMediatorFieldInfo.GetAsString: string;
+begin
+  Result := Format('%s|%s|%d|%s', [PropertyName, AlignChars[Alignment], Width, Caption]);
+end;
+
+procedure TMediatorFieldInfo.SetAsString(const AValue: string);
+
+  Function GetToken(Var S : String) : String;
+
+  Var
+    P : Integer;
+
+  begin
+    P:=Pos('|',S);
+    If P=0 then P:=Length(S)+1;
+    Result:=Copy(S,1,P-1);
+    Delete(S,1,P);
+  end;
+
+var
+  V,S: string;
+  A: TAlignment;
+  I: integer;
+
+begin
+  V:=S;
+  I := 0;
+  PropertyName:=GetToken(V);
+  if (PropertyName = '') then
+    MediatorError(Self,SErrInvalidFieldName, [Index + 1]);
+  Alignment:=taLeftJustify;
+  Width:=50;
+  S:=GetToken(V);
+  if (S<>'') then
+    begin
+    if (length(S)<>1) then
+      MediatorError(Self,SErrInvalidAlignmentChar, [S,Index+1]);
+    for A := Low(Talignment) to High(TAlignment) do
+      if (Upcase(AlignChars[A])=Upcase(S[1])) then
+        Alignment := A;
+    S:=GetToken(V);
+    if (S<>'') then
+      begin
+      if not TryStrToInt(S,i) then
+        MediatorError(Self,SErrInvalidWidthSpecifier,[S]);
+      Width:=I;
+      S:=getToken(V);
+      if (S<>'') then
+        Caption := S;
+      end;
+    end;
+end;
+
+procedure TMediatorFieldInfo.Assign(Source: TPersistent);
+
+Var
+  M : TMediatorFieldInfo;
+
+begin
+  if (Source is TMediatorFieldInfo) then
+    begin
+    M:=Source as TMediatorFieldInfo;
+    FWidth:=M.FWidth;
+    FCaption:=M.FCaption;
+    FPropName:=M.FPropname;
+    FAlign:=M.FAlign;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TColumnsListItemMediator }
+
+function TColumnsListItemMediator.GetFieldsInfo: TMediatorFieldInfoList;
+begin
+  If Assigned(FListmediator) and (FListMediator is TColumnsListMediator) then
+    Result:=TColumnsListMediator(FListMediator).FFieldsInfo;
+end;
+
+{ TBaseListMediator }
+
+procedure TBaseListMediator.SetOnBeforeSetupField(
+  const Value: TOnBeforeSetupField);
+
+var
+  I: integer;
+begin
+  FOnBeforeSetupField := Value;
+  for I := 0 to FMediatorList.Count - 1 do
+    TListItemMediator(FMediatorList[i]).OnBeforeSetupField := Value;
+end;
+
+class function TBaseListMediator.PublishedViewProperty: Boolean;
+begin
+  Result:=False;
+end;
+
+procedure TBaseListMediator.SetActive(const AValue: Boolean);
+
+Var
+  i : Integer;
+
+begin
+  inherited SetActive(AValue);
+  If AValue then
+    For I:=0 to MediatorList.Count-1 do
+      TListItemMediator(MediatorList[i]).MaybeObjectToView;
+end;
+
+function TBaseListMediator.GetSelectedObject: TObject;
+begin
+  Result := nil;
+end;
+
+procedure TBaseListMediator.SetSelectedObject(const AValue: TObject);
+begin
+  // Do nothing
+end;
+
+procedure TBaseListMediator.DoDeleteItemMediator(AIndex: Integer;
+  AMediator: TListItemMediator);
+begin
+  MediatorList.Delete(AIndex);
+end;
+
+Function TBaseListMediator.AddObject(AObject : TObject; AIndex : Integer) : TListItemMediator;
+
+
+begin
+  Result:=CreateItemMediator(AObject,AIndex);
+  If (Result<>Nil) then
+    begin
+    Result.FListMediator:=Self;
+    Result.Subject:=AObject;
+    MediatorList.Add(Result);
+    end;
+end;
+
+procedure TBaseListMediator.CreateSubMediators;
+
+var
+  I : integer;
+  Model : TObjectList;
+  
+begin
+  Model:=Subject as TObjectList;
+  for i := 0 to Model.Count - 1 do
+    begin
+    if i < MediatorList.Count then
+      TListItemMediator(MediatorList[i]).Subject := Model[i]
+    else
+      AddObject(Model[i], i);
+    end;
+  for i := MediatorList.Count-1 downto Model.Count do
+    DoDeleteItemMediator(I,TListItemMediator(MediatorList[i]));
+  FListChanged:=False;
+end;
+
+procedure TBaseListMediator.DoViewToObject;
+begin
+  // Do nothing
+end;
+
+procedure TBaseListMediator.DoObjectToView;
+begin
+  CreateSubMediators;
+end;
+
+procedure TBaseListMediator.SetSubject(const AValue: TObject);
+
+Var
+  V : TOBject;
+
+begin
+  if (AValue <> nil) then
+    begin
+    V:=Nil;
+    if (AValue is TObjectList) then
+      V:=AValue
+    else If (AValue is TList) then
+      V:=AValue
+    else If (AValue is TCollection) then
+      V:=AValue;
+    if (V=Nil) then
+      RaiseMediatorError(SErrNotListObject, [AValue.ClassName]);
+    end;
+  FListChanged:=True;
+  inherited SetSubject(AValue)
+end;
+
+function TBaseListMediator.FindObjectMediator(AObject: TObject; out
+  AtIndex: Integer): TListItemMediator;
+begin
+  AtIndex:=FMediatorList.Count-1;
+  While (AtIndex>=0) and (TListItemMediator(FMediatorList[AtIndex]).Subject<>AObject) do
+    Dec(AtIndex);
+  If (AtIndex=-1) then
+    Result:=Nil
+  else
+    Result:=TListItemMediator(FMediatorList[AtIndex]);
+end;
+
+constructor TBaseListMediator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMediatorList := TFPObjectList.Create;
+  Active        := False;
+  ViewPropertyName:='Caption';
+end;
+
+destructor TBaseListMediator.Destroy;
+begin
+  FreeAndNil(FMediatorList);
+  inherited Destroy;
+end;
+
+class function TBaseListMediator.CompositeMediator: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TBaseListMediator.ObservedChanged(ASender: TObject;
+  Operation: TFPObservedOperation);
+
+var
+  M     : TListItemMediator;
+  Model : TObjectList;
+  I     : Integer;
+
+begin
+  // Do not call inherited, it will rebuild the list !!
+  Case Operation of
+    ooAddItem    : AddObject(ASender,TObjectList(Subject).Count-1); // always at the end...
+    ooDeleteItem : begin
+                   M:=FindObjectMediator(ASender,I);
+                   if M<>nil then
+                     DoDeleteItemMediator(I,M);
+                   end;
+    ooChange    : begin
+                   Model:=(Subject as TObjectList);
+                   if FListChanged or (TObjectList(Model).Count<>MediatorList.Count) or (Model.Count=0) then // Safety measure
+                     MaybeObjectToView;
+                   end;
+  end;
+
+end;
+
+{ TColumnsListMediator }
+
+procedure TColumnsListMediator.SetFieldsInfo(
+  const AValue: TMediatorFieldInfoList);
+begin
+  FFieldsInfo.Assign(AValue);
+end;
+
+function TColumnsListMediator.GetDisplayNames: string;
+begin
+  Result := FFieldsInfo.AsString;
+end;
+
+procedure TColumnsListMediator.SetDisplayNames(const AValue: string);
+begin
+  SubjectPropertyName:=AValue;
+  ParseDisplayNames(AValue);
+end;
+
+procedure TColumnsListMediator.FieldInfoChanged(Item: TMediatorFieldInfo;
+  Action: TCollectionNotification);
+begin
+  If Active  then
+    RaiseMediatorError(SErrActive);
+end;
+
+class function TColumnsListMediator.PublishedSubjectProperty: Boolean;
+begin
+  Result:=False;
+end;
+
+procedure TColumnsListMediator.ParseDisplayNames(const AValue: string);
+
+  Function GetToken(Var S : String) : String;
+
+  Var
+    P : Integer;
+
+  begin
+    P:=Pos(';',S);
+    If P=0 then P:=Length(S)+1;
+    Result:=Copy(S,1,P-1);
+    Delete(S,1,P);
+  end;
+
+var
+  I : integer;
+  lField : string;
+  MFI : TMediatorFieldInfo;
+  A,S : String;
+
+begin
+  FFieldsInfo.Clear;
+  A:=AValue;
+  Repeat
+    S:=GetToken(A);
+    If (S<>'') then
+      begin
+      MFI:=FFieldsInfo.AddFieldInfo;
+      MFI.AsString:=S;
+      end;
+  until (S='');
+end;
+
+procedure TColumnsListMediator.CreateColumns;
+begin
+  // Do nothing. Must be implemented by descendent objects.
+end;
+
+procedure TColumnsListMediator.DoObjectToView;
+begin
+  CreateColumns;
+  inherited DoObjectToView;
+end;
+
+constructor TColumnsListMediator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFieldsInfo:=TMediatorFieldInfoList.create(TMediatorFieldInfo);
+  SubjectPropertyName:='Caption';
+end;
+
+destructor TColumnsListMediator.Destroy;
+begin
+  FreeAndNil(FFieldsInfo);
+  inherited Destroy;
+end;
+
+{ TMediatorFieldInfoList }
+
+function TMediatorFieldInfoList.GetAsString: string;
+
+var
+  I: integer;
+begin
+  Result := '';
+  for I := 0 to Count - 1 do
+  begin
+    if (Result <> '') then
+      Result := Result + ';';
+    Result := Result + FieldInfo[i].AsString;
+  end;
+end;
+
+function TMediatorFieldInfoList.GetI(Index: integer): TMediatorFieldInfo;
+begin
+  Result := TMediatorFieldInfo(Items[Index]);
+end;
+
+procedure TMediatorFieldInfoList.SetI(Index: integer;
+  const AValue: TMediatorFieldInfo);
+
+begin
+  Items[Index] := AValue;
+end;
+
+procedure TMediatorFieldInfoList.Notify(Item: TCollectionItem;
+  Action: TCollectionNotification);
+begin
+  inherited Notify(Item, Action);
+  If Assigned(FMediator) then
+    FMediator.FieldInfoChanged(Item as TMediatorFieldInfo,Action)
+end;
+
+function TMediatorFieldInfoList.AddFieldInfo: TMediatorFieldInfo;
+begin
+  Result := Add as TMediatorFieldInfo;
+end;
+
+function TMediatorFieldInfoList.AddFieldInfo(const APropName: String;
+  AFieldWidth: Integer): TMediatorFieldInfo;
+begin
+  Result:=AddFieldInfo();
+  Result.PropertyName:=APropName;
+  Result.Width:=AFieldWidth;
+end;
+
+function TMediatorFieldInfoList.AddFieldInfo(const APropName, ACaption: String;
+  AFieldWidth: Integer): TMediatorFieldInfo;
+begin
+  Result:=AddFieldInfo(APropName,AFieldWidth);
+  Result.Caption:=ACaption;
+end;
+
+function TMediatorFieldInfoList.AddFieldInfo(const APropName, ACaption: String;
+  AFieldWidth: Integer; AAlignment: TAlignment): TMediatorFieldInfo;
+begin
+  Result:=AddFieldInfo(APropName,ACaption,AFieldWidth);
+  Result.Alignment:=AAlignment;
+end;
+
+end.
+