unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
PMethod = ^TMethod;
TMethodList =
class(TList)
private
function GetItem(
Index: Integer): TNotifyEvent;
public
property Items[
Index :Integer]: TNotifyEvent
read GetItem;
function Add(Proc: TNotifyEvent): Integer;
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(Proc: TNotifyEvent): Integer;
var
p: PMethod;
begin
New(p);
p.Code := TMethod(Proc).Code;
p.Data := TMethod(Proc).Data;
Result :=
inherited Add(p);
end;
procedure TMethodList.Clear;
var
i: Integer;
begin
for i := Pred(Count)
downto 0
do
Dispose(PMethod(
inherited Items[i]));
inherited;
end;
procedure TMethodList.Delete(
Index: Integer);
begin
Dispose(PMethod(
inherited Items[
Index]));
inherited Delete(
Index);
end;
procedure TMethodList.Delete(Obj: TObject);
var
i: Integer;
begin
for i := Pred(Count)
downto 0
do
if PMethod(
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.