Rob Lambden
Rob Lambden

Reputation: 2293

How can I build a Generic class to manage different procedure of object types

I have a lot of common code that deals with lists of procedure of object or function of object types. I would like to standardise this code into a generic class so that the common code is shared.

If I have:

type
  TNotifyEvent = procedure (Sender: TObject) of object;
  TNotifyIntEvent = procedure (Sender: TObject; Value: Integer): Boolean of object;

Then I can have:

type
  TCallbackList = class(TList<TNotifyEvent>)
  end;
  TIntCallbackList = class(TList<TIntNotifyEvent>)
  end;

But as I have more code in here than just declaring a list, I would like to be able to declare the overall class as a Generic like this:

type
  TFunctionManager<T: procedure of object> = class(TList<T>)
  public
    procedure Subscribe(fnCallback: T);
    procedure FireCallbacks();
    procedure Unsubscribe(fnCallback: T);
    // ... and so on
  end;

However Generics do not allow the generic type parameter to be constrained to be a procedure of object

Is there a way to achieve this kind of functionality?

Upvotes: 1

Views: 529

Answers (1)

Rob Lambden
Rob Lambden

Reputation: 2293

I have found a way to implement what I need. Thinking about the problem it's obvious that the whole point of having a procedure of object type is so that you can call it. To call it you need to know the prototype for the function, and so the basic premise of using a Generic of the function prototype is too limiting.

To illustrate this: in the example in the question if the method FireCallbacks calls all of the methods in the list then if the prototype of the callback changes then the prototype of FireCallbacks needs to change. So for TFunctionManager<TNotifyIntEvent> I would need to declare procedure FireCallbacks(Value: Int); so that I have enough parameters to call the routines.

As the procedure of object type is stored in memory as a TMethod irrespective of what the prototype of the method is we can build a Generic class to store the procedure of objectss and handle common code, but we will have to reintroduce some of the routines which are dependent on the prototype.

The parameters to the routines can be of different types, of course, and these can be made generic, but we cannot make the number of arguments, or their order, generic.

I achieved the goal of using a Generic class to implement common code, supporting different function prototypes, by implementing the base class on TNotifyEvent (any procedure of object type would do but this made sense for my requirements) and then having derived classes, with generic types, to support callbacks with different signatures.

The following code provides the bare bones of how I implemented it (not all code is shown, just the bits relevent to using Generics on function prototypes, but it should be enough to get you started if you want to do this):

interface

type
  TCallbackManager = class(TObject)
  protected
    _pCallbacks: TList<TNotifyEvent>;
  public
    constructor Create();
    destructor Destry(); override;

    procedure FireCallbacks(); virtual;
    procedure Subscribe(fnCallback: TNotifyEvent); virtual;
    procedure Unsubscribe(fnCallback: TNotifyEvent); virtual;
  end;

  T1ParamCallback<TParam1> = procedure(Sender: TObject; p1: TParam1) of Object;
  T1ParamCallbackManager<TParam1> = class(TCallbackManager)
  public
    procedure FireCallbacks(p1: TParam1); reintroduce;
    procedure Subscribe(fnCallback: T1ParamCallbackManager<TParam1>); reintroduce;
    procedure Unsubscribe(fnCallback: T1ParamCallbackManager<TParam1>); reintroduce;
  end;

  T2ParamCallback<TParam1, TParam2> = procedure(Sender: TObject; p1: TParam1; p2: TParam2) of Object;
  T2ParamCallbackManager<TParam1, TParam2> = class(TCallbackManager)
  public
    procedure FireCallbacks(p1: TParam1; p1: TParam2); reintroduce;
    procedure Subscribe(fnCallback: T2ParamCallbackManager<TParam1, TParam2>); reintroduce;
    procedure Unsubscribe(fnCallback: T2ParamCallbackManager<TParam1, TParam2>); reintroduce;
  end;

implementation

{ TCallbackManager }

constructor TCallbackManager.Create;
begin
  Self._pCallbacks:=TList<TNotifyEvent>.Create;
  inherited;
end;

destructor TCallbackManager.Destroy;
begin
  FreeAndNil(Self._pCallbacks);
  inherited;
end;

procedure TCallbackManager.FireCallbacks();
var
  fnCallback: TNotifyEvent;
begin
  for fnCallback in Self._pCallbacks do
    if(Assigned(fnCallback)) then
      fnCallback(Self);
end;

procedure TCallbackManager.Subscribe(fnCallback: TNotifyEvent);
begin
  if(not(Self._pCallbacks.Contains(fnCallback))) then
    Self._pCallbacks.Add(fnCallback);
end;

procedure TCallbackManager.Unsubscribe(fnCallback: TNotifyEvent);
begin
  Self._pCallbacks.Remove(fnCallback);
end;

{ T1ParamCallbackManager }

procedure T1ParamCallbackManager.FireCallbacks(p1: TParam1);
var
  fnCallback: TNotifyEvent;
begin
  for fnCallback in Self._pCallbacks do
    if(Assigned(fnCallback)) then
      T1ParamCallback<TParam1>(fnCallback)(Self, p1);
end;

procedure T1ParamCallbackManager.Subscribe(fnCallback: T1ParamCallback<TParam1>);
begin
  inherited Subscribe(TNotifyEvent(fnCallback));
end;

procedure T1ParamCallbackManager.Unsubscribe(fnCallback: TNotifyEvent);
begin
  inherited Unsubscribe(TNotifyEvent(fnCallback));
end;

{ T2ParamCallbackManager }

procedure T2ParamCallbackManager.FireCallbacks(p1: TParam1; p2: TParam2);
var
  fnCallback: TNotifyEvent;
begin
  for fnCallback in Self._pCallbacks do
    if(Assigned(fnCallback)) then
      T2ParamCallback<TParam1, TParam2>(fnCallback)(Self, p1, p2);
end;

procedure T2ParamCallbackManager.Subscribe(fnCallback: T2ParamCallback<TParam1, TParam2>);
begin
  inherited Subscribe(TNotifyEvent(fnCallback));
end;

procedure T2ParamCallbackManager.Unsubscribe(fnCallback: T2ParamCallback<TParam1, TParam2>);
begin
  inherited Unsubscribe(TNotifyEvent(fnCallback));
end;

Upvotes: 1

Related Questions