AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Methodenaufruf über Adresse

Ein Thema von Klaus01 · begonnen am 29. Sep 2009 · letzter Beitrag vom 29. Sep 2009
Antwort Antwort
Klaus01

Registriert seit: 30. Nov 2005
Ort: München
5.757 Beiträge
 
Delphi 10.4 Sydney
 
#1

Methodenaufruf über Adresse

  Alt 29. Sep 2009, 16:16
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
Klaus
  Mit Zitat antworten Zitat
Tryer

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

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 16:36
Genau so ist es. Ein Methodenzeiger ist eigentlich kein einfacher Zeiger, sondern ein Record "TMethod", in dem immer das Objekt mit übergeben wird.
  Mit Zitat antworten Zitat
Klaus01

Registriert seit: 30. Nov 2005
Ort: München
5.757 Beiträge
 
Delphi 10.4 Sydney
 
#3

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 16:51
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
Klaus
  Mit Zitat antworten Zitat
Tryer

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

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18: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
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.230 Beiträge
 
Delphi 12 Athens
 
#5

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18:17
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Tryer

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

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18:21
*laangweilig*.. ok es geht natürlich auch einfach
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.230 Beiträge
 
Delphi 12 Athens
 
#7

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18:23
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
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Tryer

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

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18:32
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
  Mit Zitat antworten Zitat
Klaus01

Registriert seit: 30. Nov 2005
Ort: München
5.757 Beiträge
 
Delphi 10.4 Sydney
 
#9

Re: Methodenaufruf über Adresse

  Alt 29. Sep 2009, 18:45
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
Klaus
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:08 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz