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.