Discussion :

[Rustine]

Bonjour à tous,
je suis en train de mettre en place l'appel de methodes depuis leur nom grâce à MethodName.
La partie récuperation d'adresse marche nickel. Par contre dans la methode appelée, j'utilise des variables locales privées de la classe contenant la méthode appelée. C'est la que j'ai des problème de violation d'accès.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TClasseB = class(Tobject)
    constructor Create;
    destructor Destroy;override;
  public
    Param1 : Single;
    Param2 : Integer;
  end;
 
type
  TClasseA = class(Tobject)
    constructor Create;
    destructor Destroy;override;
  private
    FClasseB : TClasseB;
    Param1 : Single;
    Param2 : Integer;
  published
    function test(ParamArray : array of single): boolean;
  end;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    ClasseA : TClasseA;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ClasseA := TClasseA.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClasseA.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  proc : function (ParamArray : array of single): boolean of object;
  params : array of single;
begin
  @proc := ClasseA.MethodAddress('test');
  if @proc <> nil then begin
    SetLength(params,2);
    params[0] := 1000;
    params[1] := 2000;
    proc(params);
  end else begin
    ShowMessage('Methode non trouvée');
  end;
end;
 
{ TClasseA }
 
constructor TClasseA.Create;
begin
  FClasseB := TClasseB.Create;
  Param1 := 0;
  Param2 := 0;
end;
 
destructor TClasseA.Destroy;
begin
 
  inherited Destroy;
end;
 
function TClasseA.test(ParamArray: array of single): boolean;
var
  Param1 : single;
  param2 : integer;
begin
  if Assigned(FClasseB) then begin
    Param1 := ParamArray[0];
    Param2 := Round(ParamArray[1]);
    FClasseB.Param1 := ParamArray[0]; // <- acces violation si appelée depuis button1click;
    FClasseB.Param2 := Round(ParamArray[1]);
    test := True;
  end else begin
    test := False;
  end;
end;
 
{ TClasseB }
 
constructor TClasseB.Create;
begin
  Param1 := 0;
  Param2 := 0;
 
end;
 
destructor TClasseB.Destroy;
begin
 
  inherited Destroy;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  ClasseA.test([1000,2000]);
end;
 
end.

En fait lorsque la function est appellée par MethodName, touts objets appartenants à la classe hors de la méthode n'ont pas l'air d'exister.

L'appel direct de la fonction test par l'objet classeB marche sans problème, contrairement à l'appel par adresse;

Merci d'avance pour ceux qui éclaireront ma lanterne.

Rustine

[sjrd]

Les procedure of object sont en fait des TMethod, qui ont 2 champs : Code et Data.
Au lieu de faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

@proc := ClasseA.MethodAddress('test');

Il faut faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
TMethod(Proc).Code := ClasseA.MethodAddress('test');
TMethod(Proc).Data := ClasseA;

Si tu dois faire ça plusieurs fois, utilise cette petite routine :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
{*
  Recherche une méthode d'un objet à partir de son nom
  La méthode en question doit être publiée pour pouvoir être trouvée.
  @param Obj          L'objet définissant la méthode
  @param MethodName   Nom de la méthode
  @return Une référence à la méthode recherchée pour l'objet Obj
*}
function GetMethodFromName(Obj : TObject; const MethodName : ShortString) : TMethod;
begin
  Result.Code := Obj.MethodAddress(MethodName);
  Result.Data := Obj;
end;

Et après :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TMethod(Proc) := GetMethodFromName(ClasseA, 'test');

[anapurna]

salut

bon pas assez rapide

voila le code que j'ai teste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
type
  Tproc = function (ParamArray : array of single): boolean of object;
 
procedure TMAFORM.Button1Click(Sender: TObject);
var
  params : array of single;
  proc : Tproc;
  mt : TMethod;
begin
  mt.data := pointer(ClasseA);
  mt.code := ClasseA.MethodAddress('test');
  if assigned(mt.code) then
  begin
    proc := Tproc(mt);
    SetLength(params,2);
    params[0] := 1000;
    params[1] := 2000;
    proc(params);
  end else begin
    ShowMessage('Methode non trouvée');
  end;
end;

[Rustine]

Merci les amis, je viens de tester la méthode de sjrd (qui s'avère etre la meme chose que toi anapurna).

Ca marche tres bien.

Merci encore