Methodenaufruf über Adresse

[himitsu]

ich würde nicht so viel mit TMethod rumspielen ... TNotifyEvent/PNotifyEvent sollten da wohl etwas verständlicher wirken.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  PNotifyEvent = ^TNotifyEvent;

  TMethodList = class(TList)
  private
    function GetItem(Index: Integer): TNotifyEvent;
  public
    property Items[Index :Integer]: TNotifyEvent read GetItem;
    function Add(const Proc: TNotifyEvent): Integer;
    procedure Delete(const Proc: TNotifyEvent); overload;
    procedure Delete(Obj: TObject); overload;
    procedure Delete(Index: Integer); overload;
    procedure Clear; override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    List: TMethodList;
    procedure Dummy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMethodList }

function TMethodList.Add(const Proc: TNotifyEvent): Integer;
var N: PNotifyEvent;
begin
  New(N);
  N^ := Proc;
  Result := inherited Add(N);
end;

procedure TMethodList.Clear;
var
  i: Integer;
begin
  for i := Pred(Count) downto 0 do
    Dispose(PNotifyEvent(inherited Items[i]));
  inherited;
end;

procedure TMethodList.Delete(Index: Integer);
begin
  Dispose(PNotifyEvent(inherited Items[Index]));
  inherited Delete(Index);
end;

procedure TMethodList.Delete(const Proc: TNotifyEvent);
var
  i: Integer;
begin
  for i := Pred(Count) downto 0 do
    if CompareMem(inherited Items[i], @TMethod(Proc), SizeOf(TMethod)) then
      Delete(i);
end;

procedure TMethodList.Delete(Obj: TObject);
var
  i: Integer;
begin
  for i := Pred(Count) downto 0 do
    if TMethod((inherited Items[i])^).Data = Obj then
      Delete(i);
end;

function TMethodList.GetItem(Index: Integer): TNotifyEvent;
begin
  Result := TNotifyEvent(inherited Items[Index]^);
end;

procedure TForm1.Dummy(Sender: TObject);
begin
  beep;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List := TMethodList.Create;
  List.Add(OnClick);
  List.Add(Dummy);   // test ob Zuweisung ohne Parameterübergabe klappt -> i.O.
  List.Items[0](self);
  List.Items[1](self);
  List.Free;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  color := clgreen;
end;

end.