unit UnitTest;

interface

uses
  Classes,
  Vcl.Forms,
    DesignIntf,DesignEditors;

Type
  TAccessMethodProperty = class(TMethodProperty);

  TInstanceMode = (fimMultiple, fimSingle, fimSingleForID);

  TOptionsFormSaveProp = (opspPosition, opspState, opspGrid, opspFilter, opspMisc);

  TOptionsFormSaveProps = set of TOptionsFormSaveProp;

  TOptionsForm = class;
  TBaseCustomForm = class;

  TEventListProperty = class(TPropertyEditor)
  protected
    function GetInternalObject: TPersistent; virtual;
  public
    function GetName: string; override;
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropProc); override;
  end;

  TOptionsForm = class(TPersistent)
  private
    FInstanceMode         : TInstanceMode;
    FSaveProps            : TOptionsFormSaveProps;
    FFormIsModal          : Boolean;
    FOnObjectAssigment    : TNotifyEvent;
    FOnLoadPersistent     : TNotifyEvent;
    FOnSavePersistent     : TNotifyEvent;
    FSetControlState      : TNotifyEvent;
    FOnInstanceIdentified : TNotifyEvent;
    function GetContainer: TComponent;
  protected
    aForm: TBaseCustomForm;
    function GetOwner : TPersistent; override;
  public

    constructor Create(AOwner: TComponent);
    procedure Assign(Other: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;

    property Container: TComponent read GetContainer;
  published
    property InstanceMode: TInstanceMode         read FInstanceMode write FInstanceMode default fimMultiple;
    property SaveProps   : TOptionsFormSaveProps read FSaveProps    write FSaveProps;
    property FormIsModal : Boolean               read FFormIsModal  write FFormIsModal  default False;

    property OnLoadPersistent    : TNotifyEvent read FOnLoadPersistent     write FOnLoadPersistent;
    property OnSavePersistent    : TNotifyEvent read FOnSavePersistent     write FOnSavePersistent;
    property OnObjectAssigment   : TNotifyEvent read FOnObjectAssigment    write FOnObjectAssigment;
    property SetControlState     : TNotifyEvent read FSetControlState      write FSetControlState;
    property OnInstanceIdentified: TNotifyEvent read FOnInstanceIdentified write FOnInstanceIdentified;
  end;

  //Базовая форма
  TBaseCustomForm = class(TForm)
  private
    FOptionsForm: TOptionsForm;
    function GetActiveEvent: TNotifyEvent;
    procedure SetActiveEvent(const Value: TNotifyEvent);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ActiveOptionsForm : TOptionsForm read FOptionsForm write FOptionsForm;
    property ActiveEvents : TNotifyEvent read GetActiveEvent write SetActiveEvent;
  end;

Procedure Register;

implementation

uses
  System.TypInfo;

Procedure Register;
begin
  RegisterClasses([TOptionsForm, TBaseCustomForm]);
  RegisterCustomModule(TBaseCustomForm, TCustomModule);
  RegisterPropertyEditor(TypeInfo(TNotifyEvent), TBaseCustomForm, 'ActiveEvents', TEventListProperty);
end;

{ TEventListProperty }

function TEventListProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paSubProperties, paReadOnly, paVolatileSubProperties]
end;

function TEventListProperty.GetInternalObject: TPersistent;
begin
  Result := TBaseCustomForm(GetComponent(0)).ActiveOptionsForm;
end;

function TEventListProperty.GetName: string;
begin
  Result := 'ActiveEvents';
end;

function TEventListProperty.GetValue: string;
begin
  Result := '(' + GetInternalObject.ClassName + ')';
end;

procedure TEventListProperty.GetProperties(Proc: TGetPropProc);
var
  EventCount, i: integer;
  EventList : PPropList;
  EventEditor: TMethodProperty;
begin
  EventCount := GetPropList(GetInternalObject.ClassInfo, tkMethods, nil);
  if EventCount > 0 then
  begin
    GetMem(EventList, EventCount * SizeOf(PPropInfo));
    try
      GetPropList(GetInternalObject.ClassInfo, tkMethods, EventList);
      for i := 0 to EventCount - 1 do
      begin
        EventEditor := TMethodProperty.Create(Designer, 1);
        with TAccessMethodProperty(EventEditor) do
        begin
          SetPropEntry(0, GetInternalObject, EventList[i]);
            Initialize;
            if ValueAvailable then
              Proc(EventEditor as IProperty)
        end
      end
    finally
      FreeMem(EventList, EventCount * SizeOf(PPropInfo))
    end
  end
end;

{ TOptionsForm }

procedure TOptionsForm.Assign(Other: TPersistent);
begin
  if Other = nil then
    Exit;

  if (Other is TOptionsForm) then
    begin
      FInstanceMode      := TOptionsForm(Other).InstanceMode;
      FSaveProps         := TOptionsForm(Other).SaveProps;
      FFormIsModal       := TOptionsForm(Other).FormIsModal;
      FOnObjectAssigment := TOptionsForm(Other).OnObjectAssigment;
      FOnLoadPersistent  := TOptionsForm(Other).OnLoadPersistent;
      FOnSavePersistent  := TOptionsForm(Other).OnSavePersistent;
      FSetControlState   := TOptionsForm(Other).SetControlState;
      FOnInstanceIdentified := TOptionsForm(Other).OnInstanceIdentified;
    end
  else
    inherited;
end;

procedure TOptionsForm.AssignTo(Dest: TPersistent);
begin
  if Dest = nil then
    Exit;

  if (Dest is TOptionsForm) then
    begin
      TOptionsForm(Dest).InstanceMode         := FInstanceMode;
      TOptionsForm(Dest).SaveProps            := FSaveProps;
      TOptionsForm(Dest).FormIsModal          := FFormIsModal;
      TOptionsForm(Dest).OnObjectAssigment    := FOnObjectAssigment;
      TOptionsForm(Dest).OnLoadPersistent     := FOnLoadPersistent;
      TOptionsForm(Dest).OnSavePersistent     := FOnSavePersistent;
      TOptionsForm(Dest).SetControlState      := FSetControlState;
      TOptionsForm(Dest).OnInstanceIdentified := FOnInstanceIdentified;
    end
  else
    inherited;
end;

constructor TOptionsForm.Create(AOwner: TComponent);
begin
//  inherited Create(AOwner);
  aForm := AOwner as TBaseCustomForm;
  //Устанавливаем значения по-умолчанию
  FInstanceMode := fimMultiple;
  FSaveProps    := [opspPosition, opspState, opspGrid, opspFilter, opspMisc];
  FFormIsModal  := False;
end;


function TOptionsForm.GetContainer: TComponent;
begin
  Result := aForm as TComponent;
end;

function TOptionsForm.GetOwner: TPersistent;
begin
  Result := aForm;
end;

{ TBaseCustomForm }

constructor TBaseCustomForm.Create(AOwner: TComponent);
begin
  inherited;
  ActiveOptionsForm := TOptionsForm.Create(Self);
end;


destructor TBaseCustomForm.Destroy;
begin
  FOptionsForm.Free;
  inherited;
end;

function TBaseCustomForm.GetActiveEvent: TNotifyEvent;
begin
  Result := nil;
end;

procedure TBaseCustomForm.SetActiveEvent(const Value: TNotifyEvent);
begin
  //Do nothing
end;

end.