Einzelnen Beitrag anzeigen

Tryer

Registriert seit: 16. Aug 2003
200 Beiträge
 
#4

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 19:05
Das beste wäre natürlich wenn alle Objekte die gleiche Basisklasse haben, dann könntest Du nur die Objekte speichern und weißt dann ja das "Update" existiert / kannst es aufrufen.

Alternativ könnte man so eine "TMethodList" gestalten, hier als Beispiel mit TNotifyEvent:
Delphi-Quellcode:
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.
Grüsse, Dirk
  Mit Zitat antworten Zitat