Archive

Archive for March 20, 2015

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

March 20, 2015 Leave a comment

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 🙂