Home > Object Pascal > Delegates, a fun look at multi-casting with Smart Pascal

Delegates, a fun look at multi-casting with Smart Pascal

This is just for fun, but here is the smallest possible delegate (read: multi-cast events) I could come up with. The lack of generics makes this tricky (its even tricky with generics), so this is probably as close as we get.

It should be easy enough to add operator overloading in the += and -= style made popular by Smart Pascal and C#, that way you could do stuff like:

// Install a new delegate handler
FHandle:=FDelegateOnClick += Procedure (sender:TObject;e:TDelegateParams)
  begin
  end;

// Uninstall handler
FDelegateOnClick -= FHandle;

Well, here is the code. Small and compact as always:

type

  TDelegateNameValuePair = Record
    nvName:   String;
    nvValue:  Variant;
  end;
  TDelegatePairList = array of TDelegateNameValuePair;

  TDelegateParams = class(TObject)
  private
    FData:    TDelegatePairList;
  public
    property  Data:TDelegatePairList read FData write FData;
    function  Set(const ValueName:String;
              const Data:Variant):TDelegateNameValuePair;
    function  Get(const ValueName:String):Variant;
  end;
  TDelegateParamsClass = Class of TDelegateParams;

  TDelegateProcedure  = procedure (sender:TObject;e:TDelegateParams);
  TDelegateEntryList = Array of TDelegateProcedure;

  TCustomDelegate = Class
  private
    FEntries: TDelegateEntryList;
  public
    function  CreateParams:TDelegateParams;virtual;
    function  Add(const Entrypoint:TDelegateProcedure):THandle;
    procedure Remove(Const Handle:THandle);
    procedure Invoke(const Params:Array of Variant);overload;virtual;
    procedure Invoke(const sender:TObject;const Params:TDelegateParams);overload;
  end;

//###########################################################################
// TDelegateParams
//###########################################################################

function TDelegateParams.Get(const ValueName:String):Variant;
var
  x:  integer;
begin
  result:=null;
  for x:=0 to FData.Count-1 do
  begin
    if sametext(ValueName,FData[x].nvName) then
    begin
      result:=FData[x].nvValue;
      break;
    end;
  end;
end;

function TDelegateParams.Set(const ValueName:String;
         const Data:Variant):TDelegateNameValuePair;
begin
  result.nvName:=ValueName;
  result.nvValue:=Data;
  FData.add(result);
end;

//###########################################################################
// TCustomDelegate
//###########################################################################

function TCustomDelegate.CreateParams:TDelegateParams;
begin
  result:=TDelegateParams.Create;
end;

procedure TCustomDelegate.Remove(Const Handle:THandle);
var
  x:  Integer;
  src:  THandle;
begin
  for x:=0 to FEntries.count-1 do
  begin
    asm @src = (@self).FEntries[@x]; end;
    if Src = Handle then
    begin
      FEntries.Delete(x,1);
      break;
    end;
  end;
end;

function TCustomDelegate.Add(const Entrypoint:TDelegateProcedure):THandle;
begin
  asm ((@self).FEntries).push(@Entrypoint); end;
  asm @result = @Entrypoint; end;
end;

procedure TCustomDelegate.Invoke(const sender:TObject;
          const Params:TDelegateParams);
var
  x:  integer;
begin
  for x:=0 to FEntries.count-1 do
  begin
    try
      FEntries[x](sender,Params);
    except
      on e: exception do;
    end;
  end;
end;

procedure TCustomDelegate.Invoke(const Params:Array of Variant);
var
  x,y:    integer;
  mParams:TDelegateParams;
begin
  for y:=0 to FEntries.count-1 do
  begin
    mParams:=createParams;
    for x:=0 to Params.count-1 do
    mParams.set("value" + x.toString,params[x]);
    try
      FEntries[y](self,mParams);
    except
      on e: exception do;
    end;
  end;
end;

Using the delegate

Since I did not include operator overloading, we resort to anonymous procedures to register our handler. Please note that TCustomDelegate.Add() return a reference-handle which you can use to un-install the handler procedure later (!)

Here is how you can go about it. Also notice that Invoke() is overloaded, so you can invoke the delegate passing the parameters as an array of variant.

var
  mDelegate:  TCustomDelegate;
begin

  mDelegate:=TCustomDelegate.Create;
  mDelegate.Add(
    Procedure (sender:TObject;e:TDelegateParams)
    begin
      showmessage(e.data[0].nvValue);
    end
  );
  mDelegate.Invoke([Variant("this is a test")]);

Remember to derive your own delegate objects, and also to override the CreateParams method to return your own parameter instances.

So in short: Inherit from the customdelegate with your own class. Override and derive your own TDelegateParams. You may also want to get rid of the read/write stuff since that is quite slow. Change that with your own parameters for the delegate.

This is actually how we create events and delegates in C# — so it’s hard work 🙂

Advertisements
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: