Reputation: 2293
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
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 objects
s 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