Liste mit Zeiger auf Funktionen

[MmVisual]

Hallo,

Ich möchte gerne in eine TList Zeiger auf Funktionen ablegen.
Mit AddCanEvent(evt: TCanEvent): Integer; möchte ich dieser Liste was hinzufügen.

Dazu habe ich folgendes deklariert:
PCanEvent = ^TCanEvent;
TCanEvent = Procedure (CanMsg: TCanMsg) Of Object;

nun zum Problem:
Irgendwie wird ein falscher Zeiger in die Liste aufgenommen. Ich blick da nicht durch. Anbei mein Code:

Code: Alles auswählen

PCanEvent = ^TCanEvent;
  TCanEvent = Procedure (CanMsg: TCanMsg) Of Object; 
 
Function AddCanEvent(evt: TCanEvent): Integer;
Procedure RemoveCanEvent(evt: TCanEvent);
 
Function AddCanEvent(evt: TCanEvent): Integer;
Begin
   If Not Assigned(lstCanMsgReceiver) Then
      lstCanMsgReceiver := TList.Create;
   lstCanMsgReceiver.Add(@evt);
   Result := lstCanMsgReceiver.Count - 1;
End;
 
Procedure RemoveCanEvent(evt: TCanEvent);
Var i: Integer;
Begin
   If Not Assigned(lstCanMsgReceiver) Then Exit;
   For i := 0 To lstCanMsgReceiver.Count - 1 Do
   Begin
      If lstCanMsgReceiver[i] = @evt Then
      Begin
         lstCanMsgReceiver.Delete(i);
         Break;
      End;
   End;
End; 
 
Procedure TfrmMain.SerRecData(Msg: String);
Var i: Integer;
   cMsg: TCanMsg;
   evt: PCanEvent;
Begin  
   // cMsg füllen...
   If Assigned(lstCanMsgReceiver) Then // In der Liste werden alle Empfänger von Messages gespeichert, Siehe "AddCanEvent()"
   Begin
      For i := 0 To lstCanMsgReceiver.Count - 1 Do // Alle Empfänger
      Begin
         If Assigned(lstCanMsgReceiver[i]) Then // Empfänger vorhanden
         Try
            evt := (lstCanMsgReceiver[i]); // Event auslösen
            evt^(cMsg);
         Except
         End;
      End;
   End;
End;     
 
procedure TfrmMain.FormCreate(Sender: TObject);
Begin
   AddCanEvent(@LogCanData);
End;
 
Procedure TfrmMain.LogCanData(CanMsg: TCanMsg);
Begin
   //...;
End; 
 

In der Funktion "AddCanEvent" hat evt den Wert 0x42eeb0. Wenn die Funktion ausgeführt werden soll, also in "SerRecData", dann hat der Zeiger evt den Wert 0x6facc, also Exception, ist ja klar. Aber wie kriege ich es hin, dass in der Liste wirklich das richtige drin ist und meine Funktionen, korrekt angesprungen werden?

Ich vermute, dass der Fehler in "AddCanEvent" schon passiert, da hier der Zeiger auf den Zeiger auf evt und nicht den Zeiger auf evt in die Liste kommt, aber ich weiß nicht wie ich es Lazarus bei bringe, dass es so tut wie ich gerne möchte.
Wenn die Zeile so aussieht:
lstCanMsgReceiver.Add(Pointer(evt));
Dann meckert der Compiller.
lstCanMsgReceiver.Add(Addr(evt));
Dann klappt es auch nicht.

Vielen Dank für eure Hilfe, Gruß Markus

[mse]

Dazu habe ich folgendes deklariert:
PCanEvent = ^TCanEvent;
TCanEvent = Procedure (CanMsg: TCanMsg) Of Object;

TCanEvent enthält je einen pointer auf den Procedurecode und die Instanz des Objekts und kann daher nicht als einfacher pointer in einer TList gespeichert werden.

Martin

[theo]

http://www.delphi-treff.de/backstage/in ... enzeigern/" onclick="window.open(this.href);return false;

[MmVisual]

@ theo:
Super, klasse Tipp es funzt!
Auf die Idee wäre ich niemals alleine gekommen.

Anbei als Dankeschön der Code...

Code: Alles auswählen

var
  lstCanMsgReceiver: TList;
 
Function AddCanEvent(evt: TCanEvent): Integer;
Procedure RemoveCanEvent(evt: TCanEvent); 
 
Implementation
  
Function AddCanEvent(evt: TCanEvent): Integer;
Begin
   If Not Assigned(lstCanMsgReceiver) Then
      lstCanMsgReceiver := TList.Create;
   lstCanMsgReceiver.Add(TMethod(evt).Code);
   lstCanMsgReceiver.Add(TMethod(evt).Data);
   Result := lstCanMsgReceiver.Count - 2;
End;
 
Procedure RemoveCanEvent(evt: TCanEvent);
Var i: Integer;
Begin
   If Not Assigned(lstCanMsgReceiver) Then Exit;
   i := 0;
   While i <= lstCanMsgReceiver.Count - 2 Do
   Begin
      If (lstCanMsgReceiver[i] = TMethod(evt).Code) And (lstCanMsgReceiver[i + 1] = TMethod(evt).Data) Then
      Begin
         lstCanMsgReceiver.Delete(i);
         lstCanMsgReceiver.Delete(i);
         Exit;
      End;
      Inc(i, 2);
   End;
End; 
 
Procedure TfrmMain.SerRecData(Msg: String);
Var cMsg: TCanMsg;
   evt: TCanEvent;
Begin
   If Assigned(lstCanMsgReceiver) Then // In der Liste werden alle Empfänger von Messages gespeichert, Siehe "AddCanEvent()"
   Begin
      i := 0;
      While i <= lstCanMsgReceiver.Count - 2 Do // Alle Empfänger
      Begin
         If Assigned(lstCanMsgReceiver[i]) Then // Empfänger vorhanden
         Try
            TMethod(evt).Code := lstCanMsgReceiver[i]; // Event laden
            TMethod(evt).Data := lstCanMsgReceiver[i + 1];
            evt(cMsg); // Event auslösen
         Except
         End;
         Inc(i, 2);
      End;
   End;
End;
 
procedure TfrmMain.FormCreate(Sender: TObject);
Begin
   AddCanEvent(@LogCanData);
End;
 
Procedure TfrmMain.LogCanData(CanMsg: TCanMsg);
Begin
   //...;
End;

[mse]

In MSEgui gibt es für den Zweck tmethodlist, welche als Basis für spezialisierte Versionen dient. Unit lib/common/kernel/mselist.pas:

Code: Alles auswählen

 
 tmethodlist = class(trecordlist)
  private
   function getitems(index: integer): tmethod;
   procedure setitems(index: integer; const avalue: tmethod);
  protected
   factitem: integer;
  public
   constructor create;
   function indexof(const value: tmethod): integer;
   function add(const value: tmethod): integer;
          //creates no duplicates
   function remove(const value: tmethod): integer;
   property items[index: integer]: tmethod read getitems
                                          write setitems; default;
 end;
 

Die items property ist neu und nur in der SVN trunk Version enthalten. Bitte vergiss nicht, die Verweise auf freigegebene Objekte aus der Liste zu entfernen.

[MmVisual]

Vielen Dank, werd ich nehmen, wenn meine Liste doch nicht tun sollte oder noch unerwünschte Seiteneffekte hat.

[Christian]

Se hat den unerwünschten Seiteneffekt das sie in MseGui enthalten ist

[mse]

Se hat den unerwünschten Seiteneffekt das sie in MseGui enthalten ist

Die Listen- und andere allgemeine Funktionen in MSEgui sind selbstverständlich unabhängig von den
GUI-Funktionen.