MultiCaster in Delphi

[stoxx]

hier mal eine allgemeine Klasse für Multicast Events ...

ein etwas schlechteres Beispiel:
http://www.delphipraxis.net/internal...ct.php?t=93201



(im folgenden Link kann man sehen, wie man die Klasse TMulticaster verwenden kann)
(es müssen aber noch die Setter Proceduren von EventMouseDown und EventMouseUp in dem Beispiel geändert werden)

http://www.delphipraxis.net/internal...253&highlight=

Delphi-Quellcode:

unit xClasses;

interface

uses Windows, classes, sysutils, ExtCtrls;




type





//==============================================================================

  TMethodReference = procedure of object;

  TMethodReferenceList = class(TObject)
  private
    FOwner : Tobject;

 strict private
    procedure AddRef(aMethodReference: TMethodReference);
    procedure RemoveRef(aMethodReference: TMethodReference);
    procedure Clear;
 protected
     FList: TList;
  public
    procedure Add(const Method : TMethod);
    procedure Remove(const Method : TMethod);
    constructor Create(Owner : TObject);
    destructor Destroy; override;
    procedure RemoveAllForAnObject(anObject: TObject);
    procedure Delete(Index: Integer);

  end;

//==============================================================================


  TMulticaster = class(TMethodReferenceList)
  strict private
    function Get_Item(Index : Integer) : TMethod;
    function Get_Count : Integer;
  public
//    procedure Broadcast(EventArgs: TEventArgs);
    property Items[Index: Integer]: TMethod read Get_Item; default;
    property Count : Integer read Get_Count;

  end; // TCustomMultiCaster

//==============================================================================
// DATA MultiCaster

type
    // Eintrag der Liste
    TMMData = record
        MethodReference : TMethodReference;
        UserData        : TObject;
    end;
//==============================================================================
  TDataMulticaster = class(TObject)
  strict private

    FList: TList;
    function Get_Item(Index : Integer) : TMethod;
    function Get_UserData(Index : Integer) : TObject;
    function Get_Count : Integer;
    procedure Clear;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Const Method : TMethod; User : TObject);  // es kann ein Userdefiniertes Object hinterlegt werden
    procedure Remove(const Method : TMethod);
    procedure RemoveAllForAnObject(anObject: TObject);
    property Items[Index: Integer]: TMethod read Get_Item; default;
    property Userdaten[Index : Integer] : TObject read Get_USerData;
    property Count : Integer read Get_Count;
    procedure Delete(Index: Integer);
  end; // TCustomMultiCaster

//==============================================================================


implementation




////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//
//
//      TMultiCaster
//
//
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

// TMethodReferenceList

constructor TMethodReferenceList.Create(Owner : TObject);
begin
  inherited create;
  FList := TList.Create;
  FOwner := Owner;
end;

//////////////////////////////////////////////////////////////////////////////

destructor TMethodReferenceList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////

procedure TMethodReferenceList.Clear;
var pMethodReference: ^TMethodReference;
begin
  while (FList.Count > 0) do
  begin
    pMethodReference := FList.Items[0];
    Dispose(pMethodReference);
    FList.Delete(0);
  end;
end;

// TMethodReferenceList/////////////////////////////////////////////////////////



procedure TMethodReferenceList.AddRef(aMethodReference: TMethodReference);
var pMethodReference: ^TMethodReference;
    i: integer;
begin
  // Look at each method in the collection to see if aMethodReference has
  // already been added.
  for i := 0 to (FList.Count - 1) do
  begin

    pMethodReference := FList.Items[i];
    // Don't do anything if the method reference has already been stored.
    if    ( TMethod(pMethodReference^).Code = TMethod(aMethodReference).Code )
      and ( TMethod(pMethodReference^).Data = TMethod(aMethodReference).Data )
      then exit;
  end;

  New(pMethodReference);
  pMethodReference^ := aMethodReference;
  FList.Add(pMethodReference);
end;

// TMethodReferenceList/////////////////////////////////////////////////////////

procedure TMethodReferenceList.RemoveRef(aMethodReference: TMethodReference);
var pMethodReference: ^TMethodReference;
    i: integer;
begin

  for i := (FList.Count - 1) downto 0 do
  begin
    pMethodReference := FList.Items[i];

    if    ( TMethod(pMethodReference^).Code = TMethod(aMethodReference).Code )
      and ( TMethod(pMethodReference^).Data = TMethod(aMethodReference).Data ) then
    begin
      Dispose(pMethodReference);
      FList.Delete(i);
      exit;
    end;  // von if begin
  end; // von for
end;
//==============================================================================
// Add und Remove (öffentlich) für die Methoden
//==============================================================================

procedure TMethodReferenceList.Add(const Method: TMethod);
begin
self.AddRef(TMethodReference(Method));
end;
//==============================================================================
procedure TMethodReferenceList.Remove(const Method: TMethod);
begin
self.RemoveRef(TMethodReference(Method));
end;

//==============================================================================
procedure TMethodReferenceList.Delete(Index: Integer);
begin
  self.FList.Delete(Index);
end;

//==============================================================================

procedure TMethodReferenceList.RemoveAllForAnObject(anObject: TObject);
var pMethodReference: ^TMethodReference;
    i: integer;
begin

  for i := (FList.Count - 1) downto 0 do
  begin
    pMethodReference := FList.Items[i];
    // If any procedure or function reference is associated with the passed
    // object then de-allocate its memory and remove the reference from FList.
    if    ( TMethod(pMethodReference^).Data = anObject ) then
    begin
      Dispose(pMethodReference);
      FList.Delete(i);
    end; // then begin
  end; // for
end;


//==============================================================================


//procedure TMulticaster.Broadcast(EventArgs: TEventArgs);
//var i: integer;
//    pNotifyEventArgs: ^TNotifyEventArgs;
//
//begin
//  try
//  for i := 0 to (FList.Count - 1) do
//    begin
//      pNotifyEventargs := FList.Items[i];
//      pNotifyEventArgs^(FOwner, EventArgs);
//
//    end;
//  finally
//    if assigned(EventArgs) then  EventArgs.Free;
//  end; //  try..finally
//end; // broadcast

//==============================================================================

function TMulticaster.Get_Count: Integer;
begin
  result := FList.Count;
end;   // Get_Count

//==============================================================================

function TMulticaster.Get_Item(Index : Integer): TMethod;
begin
 result := TMEthod(FList[Index]^);
end;

//==============================================================================

// DATA !!! MultiCaster
{ TDataMulticaster }


constructor TDataMulticaster.Create;
begin
inherited create;
FList := TList.Create;

end;

//==============================================================================

destructor TDataMulticaster.Destroy;
begin
  clear;
  FList.Free;
  inherited;
end;

//==============================================================================

procedure TDataMulticaster.Clear;
var pMMData: ^TMMData;
begin
  while (FList.Count > 0) do
  begin
    pMMData := FList.Items[0];
    Dispose(pMMData);
    FList.Delete(0);
  end;

end;

//==============================================================================

procedure TDataMulticaster.Add(const Method: TMethod; User: TObject);
var pMMData: ^TMMData;
    i: integer;
begin
  // Look at each method in the collection to see if aMethodReference has
  // already been added.
  for i := 0 to (FList.Count - 1) do
  begin

    pMMData := FList.Items[i];

    if (TMethod(pMMData.MethodReference).Code = TMethod(Method).Code ) and
       (TMethod(pMMData.MethodReference).Data = TMethod(Method).Data ) and
       (pMMData.UserData = User) then begin
          exit;
       end;  // if


  end; // for

  New(pMMData);
  pMMData.MethodReference := TMethodReference(Method);
  pMMData.UserData := User;
  FList.Add(pMMData);

end;

//==============================================================================


procedure TDataMulticaster.Remove(const Method: TMethod);
var pMMData: ^TMMData;
    i: integer;
begin

  for i := (FList.Count - 1) downto 0 do
  begin
    pMMData := FList.Items[i];

    if (TMethod(pMMData.MethodReference).Code = TMethod(Method).Code ) and
       (TMethod(pMMData.MethodReference).Data = TMethod(Method).Data ) then begin
            Dispose(pMMData);
            FList.Delete(i);
//            exit;
       end;  // if
  end; // for
end;   // Remove
//==============================================================================
procedure TDataMulticaster.RemoveAllForAnObject(anObject: TObject);
var pMMData: ^TMMData;
    i: integer;
begin
  for i := (FList.Count - 1) downto 0 do
  begin
    pMMData := FList.Items[i];
    if    ( TMethod(pMMData.MethodReference).Data = anObject ) then
    begin
      Dispose(pMMData);
      FList.Delete(i);
    end; // then begin
  end; // for
end;

//==============================================================================


procedure TDataMulticaster.Delete(Index: Integer);
var pMMData: ^TMMData;
begin
  if Index <= Flist.count - 1 then begin
      pMMData := FList[Index];
      dispose(pMMData);
      FList.Delete(Index);
  end;  // if Index < FList.count

end;

//==============================================================================

function TDataMulticaster.Get_Count: Integer;
begin
  result := FList.Count;
end;

//==============================================================================

function TDataMulticaster.Get_Item(Index: Integer): TMethod;
type
  pMMData =  ^TMMData;
begin
 result := TMEthod(  pMMData(FList[Index]).MethodReference);
end;


//==============================================================================


function TDataMulticaster.Get_UserData(Index: Integer): TObject;
type
  pMMData =  ^TMMData;
begin
 result :=  pMMData(FList[Index]).UserData;
end;


end.

[DMW]

Da lobe ich mir C++Builder - dort ist es möglich, bereits vorhandene Events als Multicast-Events zu verwenden. Templates machen's möglich :mrgreen:

Code:

//---------------------------------------------------------------------------

#include <vcl.h>
#include <ucl/bcc/multicast.hpp>
#include <ucl/bcc/multicastspec.hpp>
#pragma hdrstop

#include "main_unit.h"

//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TFrmMain *FrmMain;

//---------------------------------------------------------------------------
__fastcall TFrmMain::TFrmMain(TComponent* Owner) // Konstruktor
    : TForm(Owner)
{
        /*
         * ucl::bcc::asMulticast() erstellt das MulticastClosure-Objekt bei Bedarf.
         * die Objekte werden in der MulticastContainer-Klasse registriert und
         * gelöscht, wenn deren Destruktor aufgerufen wird.
         */

        // einen Event-Handler zu Button1->OnClick hinzufügen
    ucl::bcc::asMulticast (mcc, Button1->OnClick).push_back (this->AnotherEventHandler);

        // ein Closure explizit in ein Multicast-Closure umwandeln
    ucl::bcc::asMulticast (mcc, Button2->OnClick);

        // Referenz auf MultiCast-Objekt zurückgeben
    ucl::bcc::MulticastClosure1 <void, TObject*, ucl::bcc::ccFastcall>& mc
        = ucl::bcc::asMulticast (mcc, Button3->OnClick);

        // einen Event-Handler hinzufügen
    mc.push_front (this->Button1Click);

        // MulticastClosure-Objekte definieren eine Containerschnittstelle
    ucl::bcc::MulticastClosure1 <void, TObject*>::iterator i = mc.begin ();
    mc.insert (++i, this->Button2Click);

        // diese Anweisungen sind äquivalent:
    //mc (this);               // direkter Aufruf des MulticastClosure-Objekts
    //Button3->OnClick (this); // Aufruf des Events, dem das Objekt gehört
}

//---------------------------------------------------------------------------

void __fastcall TFrmMain::Button1Click(TObject */*Sender*/)
{
    MmoOutput->Lines->Add (AnsiString (__FUNC__) + " called.");
}
void __fastcall TFrmMain::Button2Click(TObject *Sender)
{
    MmoOutput->Lines->Add (AnsiString (__FUNC__) + " called.");
    if (Sender == Button2)
    {
        ucl::bcc::MulticastClosure1 <void, TObject*, ucl::bcc::ccFastcall>& mc
            = ucl::bcc::asMulticast (mcc, Button2->OnClick);

            // hier eine weitere Anwendung der Containerschnittstelle
        if (mc.contains (this->FooBar))
            mc.remove (this->FooBar);
        else
            mc.push_back (this->FooBar);
    }
}
void __fastcall TFrmMain::Button3Click(TObject */*Sender*/)
{
    MmoOutput->Lines->Add (AnsiString (__FUNC__) + " called.");
}

void __fastcall TFrmMain::AnotherEventHandler(TObject */*Sender*/)
{
    MmoOutput->Lines->Add (AnsiString (__FUNC__) + " called.");
}
void __fastcall TFrmMain::FooBar(TObject */*Sender*/)
{
    MmoOutput->Lines->Add (AnsiString (__FUNC__) + " called.");
}
//---------------------------------------------------------------------------

void __fastcall TFrmMain::BtnSwap13Click(TObject */*Sender*/)
{
    ucl::bcc::asMulticast (mcc, Button1->OnClick)
        .swap (ucl::bcc::asMulticast (mcc, Button3->OnClick));    
}
//---------------------------------------------------------------------------

Library und Demoprojekt hier:
http://www.audacia-software.de/de/win/ucl/index.htm

[stoxx]

Zitat:

Zitat von DMW

Da lobe ich mir C++Builder - dort ist es möglich, bereits vorhandene Events als Multicast-Events zu verwenden. Templates machen's möglich :mrgreen:

Angeber ! :)