Methodenaufruf über Adresse

[Klaus01]

Hallo Zusammen,

Delphi-Quellcode:

 // Methode einer TList hinzufügen
 procedure TComServ.attachCollector(routine: TRoutine);
  begin
    dataCollectors.Add(@routine);
  end;

  procedure TComServ.detachCollector(routine: TRoutine);
    begin
      dataCollectors.Delete(dataCollectors.IndexOf(@routine));
    end;
  
  // Routine für alle Listenmitglieder ausführen
  procedure TComServ.updateCollectors;
    var
      i :Byte;
      routine : TRoutine;
    begin
      if dataCollectors.Count > 0 then
        for i:=0 to dataCollectors.Count -1 do
          begin
            @routine := dataCollectors.Items[i];
            routine(self);
          end;
    end;

TRoutine schaut so aus:
TRoutine = procedure(comServ: TComServ) of object; Hinzufügen einer Routine:
comServ.attachCollector(update(comServ)); Beispiel update Routine:

Delphi-Quellcode:

  procedure TErrorLog.update(comServ: TComServ);
  begin
    debugLevel := comServ.dxtMonitorDebugLevel;
    MaxLines := comServ.dxtMonitorMaxLogLines;
    LogFilePath :=comServ.dxtMonitorLogFilePath;
  end;

Wenn nun den Properties etwas zugewiesen wird
knallt es:
---------------------------
Debugger Exception Notification
---------------------------
Project dxtMonitor.exe raised exception class EAccessViolation with message 'Access violation at address 00439DC4 in module 'dxtMonitor.exe'. Write of address 00000004'.
----------------------------------------------------

Wenn ich in der Update methode nur etwas ausgebe
funktioniert das ohne Probleme.

Es scheint, wenn ich die Update Methode über die Liste aufrufe,
dass dann die ObjectInstanz nicht bekannt ist.

Wie könnte ich das beheben oder umgehen.

Grüße
Klaus

[Tryer]

Genau so ist es. Ein Methodenzeiger ist eigentlich kein einfacher Zeiger, sondern ein Record "TMethod", in dem immer das Objekt mit übergeben wird.

[Klaus01]

Hallo Tryer,

danke für Deine Antwort.

Delphi-Quellcode:

procedure TErrorLog.update(comServ: TComServ);
  begin
    errorLog.debugLevel := comServ.dxtMonitorDebugLevel;
    MaxLines := comServ.dxtMonitorMaxLogLines;
    LogFilePath :=comServ.dxtMonitorLogFilePath;
  end;

Nun gut, wenn ich die Instanz entsprechend benenne
geht es - aber das finde ich nicht so sinnvoll/elegant.

Gibt es einen Weg um aus diesem Dilemma herauszukommen.

Hintergrund ist der:
comServ liest eine ini Datei.
Die Einstellungen werden von mehreren Objektklassen benutzt.
Bei der Erzeugung der Instanz werden diese Einstellungen übegeben.
Wenn sich nun die iniDatei ändert, sollen
das auch alle Instanzen mitbekommen.
Daher tragen sie ihre update Methode in eine Liste
ein, die Liste wird bei einer Veränderung der ini Datei
abgearbeitet.

Grüße
Klaus

[Tryer]

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

[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.

[Tryer]

*laangweilig*.. ok es geht natürlich auch einfach

[himitsu]

Du solltest aber auch mal noch schnell deine Delete-Procedur ändern ... hab ich auch grad gemacht, weil dort ein "böser" Fehler drin ist/war.

Delphi-Quellcode:

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

[add]
PS: ich hatte noch eine weitere Delete-Prozedur reingeschmugglt

[Tryer]

hmpf..ich hab das gerade wohl etwas zu fix zusammengehackt - das Delete war nicht wirklich eins.
Ansonsten ist dem Fragesteller natürlich freigestellt die Liste nach seinen Wünschen zu vervollständigen

[Klaus01]

Hallo ihr zwei,

danke für Eure Antworten und Vorschläge.
Wie Dirk es im Post 2 gesagt hat, habe ich es mit der Übergabe
von den kompletten Instanzen versucht - und mittlerweile klappt es
auch.

Delphi-Quellcode:

unit UMVCPattern;

interface
uses
  Contnrs,classes;

type
  TDataUser = class;

  TDataContainer = class(TThread)
    protected
      FDataUsers : TObjectList;
    public
      constructor Create;
      destructor Destroy; override;
      procedure attachDataUser(dataUser: TDataUser);
      procedure detachDataUser(dataUser: TDataUser);
      procedure updateDataUsers;
  end;

  TDataUser = class(TObject)
    protected
      FDataContainer : TDataContainer;
    public
      procedure attachTo(dataContainer: TDataContainer);
      procedure detachFrom(dataContainer: TDataContainer);
      procedure update; virtual; abstract;
  end;

implementation

  constructor TDataContainer.Create;
  begin
    inherited create(false);
    FDataUsers := TObjectList.create(false);
  end;

  destructor TDataContainer.Destroy;
  begin
    FDataUsers.Free;
    inherited destroy;
  end;

  procedure TDataContainer.attachDataUser(dataUser: TDataUser);
  begin
    if FDataUsers.IndexOf(dataUser) = -1 then
      FDataUsers.Add(dataUser);
  end;

  procedure TDataContainer.detachDataUser(dataUser: TDataUser);
  begin
    FDataUsers.Remove(dataUser);
  end;

  procedure TDataContainer.updateDataUsers;
  var
    i: Byte;
  begin
    for i:=0 to FDataUsers.Count -1 do
      begin
        (FDataUsers.Items[i] as TDataUser).update;
      end;
  end;


  procedure TDataUser.attachTo(dataContainer: TDataContainer);
  begin
    FDataContainer := dataContainer;
    FDataContainer.attachDataUser(self);
  end;

  procedure TDataUser.detachFrom(dataContainer: TDataContainer);
  begin
    FDataContainer := dataContainer;
    FDataContainer.detachDataUser(self);
    FDataContainer := nil;
  end;

end.

Da ich in der Ableitung von TDataContainer auch noch TTHread
brauchte musste ich TDataContainer von TThread ableiten.

Grüße
Klaus