|
@@ -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.
|
|
|
|
+
|