RTTI Zugriff auf Funktion

[PascalDragon]

So geht's

Code: Alles auswählen

type
  TBoolMethod = function : boolean of Object;
var
  p : Pointer;
  BoolMethod : TBoolMethod absolute p;

procedure TForm1.Button1Click(Sender: TObject);
var b : boolean;
begin
  p := Form2.MethodAddress('BoolHallo');
  TMethod(BoolMethod).code:= p;
  TMethod(BoolMethod).data:=form2;
  b := BoolMethod();
  if (b) then
    showmessage('ja')
  else
    showmessage('nein');
end;

Warum bitte machst du da einen Umweg über eine globale Variable?! Und noch dazu mit absolute?! Pointer und Methodenzeiger haben unterschiedliche Größe! Du überschreibst durch das Setzen von TMethod.Data komplett andere Daten!
Deklarier einfach eine lokale Variable vom Typ TBoolMethod in deiner Methode und arbeite mit der.

[fliegermichl]

So geht's

Code: Alles auswählen

type
  TBoolMethod = function : boolean of Object;
var
  p : Pointer;
  BoolMethod : TBoolMethod absolute p;

procedure TForm1.Button1Click(Sender: TObject);
var b : boolean;
begin
  p := Form2.MethodAddress('BoolHallo');
  TMethod(BoolMethod).code:= p;
  TMethod(BoolMethod).data:=form2;
  b := BoolMethod();
  if (b) then
    showmessage('ja')
  else
    showmessage('nein');
end;

Warum bitte machst du da einen Umweg über eine globale Variable?! Und noch dazu mit absolute?! Pointer und Methodenzeiger haben unterschiedliche Größe! Du überschreibst durch das Setzen von TMethod.Data komplett andere Daten!
Deklarier einfach eine lokale Variable vom Typ TBoolMethod in deiner Methode und arbeite mit der.

Das hatte ich zunächst versucht, aber nicht hinbekommen.
So funktioniert es jetzt bei mir.

Code: Alles auswählen

type
  TBoolMethod = function : boolean of Object;

procedure TForm1.Button1Click(Sender: TObject);
var b : boolean;
    BoolMethod : TBoolMethod;
    p : Pointer;
    M : TMethod;
begin
  p := Form2.MethodAddress('BoolHallo');
  M.code:= p;
  M.data:=form2;
  BoolMethod := TBoolMethod(M);
  b := BoolMethod();
  if (b) then
    showmessage('ja')
  else
    showmessage('nein');

end;

[PascalDragon]

Hier als ganz einfaches Beispiel, wie es funktioniert:

Code: Alles auswählen

program tmethodptr;

{$mode objfpc}

type
  {$M+}
  TTest = class
  published
    function BoolFunc: Boolean;
  private
    fBool: Boolean;
  public
    procedure Test;
  end;

type
  TBoolFunc = function: Boolean of object;

function TTest.BoolFunc: Boolean;
begin
  Result := fBool;
end;

procedure TTest.Test;
var
  b: TBoolFunc;
begin
  TMethod(b).Code := MethodAddress('BoolFunc');
  TMethod(b).Data := Self;
  
  fBool := False;
  Writeln(b());
  fBool := True;
  Writeln(b());
end;

var
  t: TTest;
begin
  t := TTest.Create;
  t.Test;
end.

[fliegermichl]

Cool, so funktioniert es auch mit Methoden, welche Parameter brauchen.
Hier ein Beispiel:

Die Direktive $M+ ist notwendig, damit einfache Klassen published Properties haben können.

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}{$M+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TMyClass }

  TMyClass = class
  published
    function StringTest(s : string) : string;
  end;


  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    myClass : TMyClass;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TMyClass }

function TMyClass.StringTest(s: string): string;
begin
  Result := 'Vortext ' + s + ' Nachtext';
end;

{ TForm1 }

type
  TStringMethod = function (s : string) : string of object;

procedure TForm1.Button1Click(Sender: TObject);
var M : TStringMethod;
begin
  TMethod(M).Code := myClass.MethodAddress('StringTest');
  TMethod(M).Data := myClass;
  ShowMessage(M('Hallo ein Text'));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  myClass := TMyClass.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  myClass.Free;
end;

end.