Discussion :

[erca57]

Soit une hiérarchie de 3 classes TTrois qui descend de TDeux qui descend de TUn.

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
unit uTestClassRef;
 
interface
 
uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs;
 
type
  TRef2Class = class of TUn;
 
  TUn = class(TObject)
  private
    FDescription: string;
  public
    constructor Create;
    procedure Afficher; virtual; abstract;
  end;
 
  TDeux = class(TUn)
  public
    constructor Create(D: string = '');
    procedure Afficher; override;
  end;
 
  TTrois = class(TDeux)
  public
    constructor Create;
  end;
 
 
implementation
 
{
************************************* TUn **************************************
}
constructor TUn.Create;
begin
  inherited Create;
  FDescription := 'Objet de classe TUn';
end;
 
{
************************************ TDeux *************************************
}
constructor TDeux.Create(D: string = '');
begin
  inherited Create;
  FDescription := 'Objet de classe TDeux';
  if D <> '' then
    FDescription := D;
end;
 
procedure TDeux.Afficher;
begin
  ShowMessage(FDescription);
end;
 
{
************************************ TTrois ************************************
}
constructor TTrois.Create;
begin
  inherited Create('Objet de classe TTrois');
end;
 
 
 
end.

Je désire les instancier à travers une référence de classe : TRef2Class = class of TUn comme ci-dessous:

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
unit uClassRefTest;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uTestClassRef, StdCtrls;
 
type
  TfmClassRef = class(TForm)
    btnT1parRef: TButton;
    btnT2parRef: TButton;
    btnT3parRef: TButton;
    btnT1Direct: TButton;
    btnT2Direct: TButton;
    btnT3Direct: TButton;
    procedure btnT3DirectClick(Sender: TObject);
    procedure btnT2DirectClick(Sender: TObject);
    procedure btnT1DirectClick(Sender: TObject);
    procedure btnT3parRefClick(Sender: TObject);
    procedure btnT2parRefClick(Sender: TObject);
    procedure btnT1parRefClick(Sender: TObject);
  private
    { Déclarations privées }
    procedure TestRef2Class(RC:TRef2Class);
  public
    { Déclarations publiques }
  end;
 
var
  fmClassRef: TfmClassRef;
 
implementation
 
{$R *.dfm}
 
procedure TfmClassRef.btnT2DirectClick(Sender: TObject);
var
  Deux: TDeux;
begin
  Deux := TDeux.Create;
  try
    Deux.Afficher;
  finally
    Deux.Free;
  end;
end;
 
procedure TfmClassRef.btnT2parRefClick(Sender: TObject);
begin
  TestRef2Class(TDeux);
end;
 
procedure TfmClassRef.btnT3DirectClick(Sender: TObject);
var
  Trois: TTrois;
begin
  Trois := TTrois.Create;
  try
    Trois.Afficher;
  finally
    Trois.Free;
  end;
end;
 
procedure TfmClassRef.btnT3parRefClick(Sender: TObject);
begin
  TestRef2Class(TTrois);
end;
 
procedure TfmClassRef.btnT1DirectClick(Sender: TObject);
var
  Un: TUn;
begin
  Un := TUn.Create;
  try
    Un.Afficher;
  finally
    Un.Free;
  end;
end;
 
procedure TfmClassRef.btnT1parRefClick(Sender: TObject);
begin
  TestRef2Class(TUn);
end;
 
procedure TfmClassRef.TestRef2Class(RC: TRef2Class);
var
  IRC: TUn;
begin
  IRC := RC.Create;
  try
    (IRC as RC).Afficher;
  finally
    IRC.Free;
  end;
end;
 
end.

Or chaque objet a un constructeur Create qui modifie la valeur d'un champ de TUn.
Or c'est toujours la valeur affectée dans le constructeur de TUn qui est restituée par la méthode Afficher. Les valeurs affectées par les contructeurs de TDeux et TTrois ne sont jamais affectées lorsqu'on instancie ces classes à travers une référence de classe.
Y a-t-il un moyen pour obtenir les messages corrects ?

[tourlourou]

et avec
(IRC as RC.ClassType).Afficher; ?
mais dans ce cas, autant déclarer
RC: TUn;

[Aka Guymelef]

Mmmh, moi j'aurai tendance à dire que c'est le transtypage avec la référence de classe derrière qui empêche le polymorphisme de fonctionner.

Et si tu fais directement :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TfmClassRef.TestRef2Class(RC: TRef2Class);
var
  IRC: TUn;
begin
  IRC := RC.Create;
  try
    IRC.Afficher;
  finally
    IRC.Free;
  end;
end;

Qu'est-ce que ça donne ?

[Pascal Jankowski]

C'est tout à fait normal dans ce cas prècis, car les construteurs de tes classes Tun, TDeux et TTrois sont statiques et donc le constructeur qui sera appelé sera toujours celui de la classe ancêtre.
Il faut donc que tu les déclares les constructeurs "vitual" pour que la bonne méthode soit appelée.

C'est la règle quant on utilise les références de class

Apporte les petites modifications suivantes:

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
TRef2Class = class of TUn;
  TUn = class(TObject)
  private
    FDescription: string;
  public
    constructor Create; virtual;
    procedure Afficher; virtual;
  end;
  TDeux = class(TUn)
  public
    constructor Create; override;
    procedure Afficher; override;
  end;
  TTrois = class(TDeux)
  public
    constructor Create; override;
  end;
 
implementation
 
constructor TUn.Create;
begin
  inherited Create;
  FDescription := 'Objet de classe TUn';
end;
 
constructor TDeux.Create;
begin
  inherited Create;
  FDescription := 'Objet de classe TDeux';
end;
 
constructor TTrois.Create;
begin
  inherited Create;
  FDescription := 'Objet de classe TTrois';
end;

Dans ce cas, ta procédure TestRef2Class t'affichera la bonne valeur.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
procedure TfmClassRef.TestRef2Class(RC: TRef2Class);
var
  reference: TUn;
begin
  reference := RC.Create;
  with reference do
  try
    Afficher;
  finally
    Free;
  end;
end;

[erca57]

Merci Pascal.
J'avais bien pensé à cette solution, mais j'ai mis virtual dans les trois classes . J'avoue que j'ai toujours eu un peu de mal avec les constructeurs. En outre, en utilisant override, je ne peux pas utiliser un create avec paramètre dans la classe TDeux. Celà ne pose pas de problème dans le cas de l'exemple que j'ai soumis a votre sagacité, mais ce n'est qu'une version très simplifiée du code dans lequel je me suis heurté au problème, et dans lequel je crée et j'initialise de nouveaux champs dans les descendants.
Encore merci à tous !

[Aka Guymelef]

Dans ce cas cela devrait donner ceci :

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
type
  TRef2Class = class of TUn;
 
  TUn = class(TObject)
  private
    FDescription: string;
  public
    constructor Create; virtual;
    procedure Afficher; virtual; abstract;
  end;
 
  TDeux = class(TUn)
  public
    constructor Create(D: string = ''); virtual;
    procedure Afficher; override;
  end;
 
  TTrois = class(TDeux)
  public
    constructor Create; override;
  end;
 
 
implementation
 
{
************************************* TUn **************************************
}
constructor TUn.Create;
begin
  inherited Create;
  FDescription := 'Objet de classe TUn';
end;
 
{
************************************ TDeux *************************************
}
constructor TDeux.Create(D: string = '');
begin
  inherited Create;
  FDescription := 'Objet de classe TDeux';
  if D <> '' then
    FDescription := D;
end;
 
procedure TDeux.Afficher;
begin
  ShowMessage(FDescription);
end;
 
{
************************************ TTrois ************************************
}
constructor TTrois.Create;
begin
  inherited Create('Objet de classe TTrois');
end;

[Yurck]

En outre, en utilisant override, je ne peux pas utiliser un create avec paramètre dans la classe TDeux.

Mais si avec override tu peux mettre un paramètre à dans la classe TDeux.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
TDeux = class(TUn)
  public
    constructor Create(MonParametre : String); override;
    procedure Afficher; override;
  end;
 
constructor TDeux.Create(MonParametre : String);
begin
  inherited TUn.Create;
  FDescription := 'Objet de classe TDeux';
end;

[erca57]

Si je mets un paramètre au Create de TDeux, à la compilation j'obtiens le message :
[Pascal Erreur] uTestClassRef.pas(27): E2037 La déclaration de 'Create' diffère de la déclaration précédente

[Pascal Jankowski]

La solution consiste à ajouter à chaque classe les create adéquat saupoudrés de quelques directives overload, virtual et override comme suit:

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
TUn = class(TObject)
  private
    FParam: string;
  public
    constructor Create;overload;virtual;
    constructor Create(monParametre: string = '');overload;virtual;
    procedure afficher;virtual;
  end;
 
  TDeux = class(TUn)
  private
  public
    constructor Create;overload;override;
    constructor Create(monParametre: string = '');overload;override;
  end;

en implémentation

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
 
constructor TUn.Create;
begin
  inherited Create;
  FParam := 'Object classe TUn';
end;
 
constructor TUn.Create(monParametre: string);
begin
  inherited Create;
  FParam := 'Objet classe TUn';
  if monParametre <> ''
    then FParam := monParametre;
end;
 
constructor TDeux.Create;
begin
  inherited;
  FParam := 'Object classe TDeux';
end;
constructor TDeux.Create(monParametre: string = '');
begin
  inherited Create(monParametre);
  FParam := 'Objet classe TDeux';
  if monParametre <> ''
    then FParam := monParametre;
end;

puis de modifier la procédure d'affichage faisant appel à la référence de classe.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
....
var
  reference: TUn;
begin
  reference := RC.Create('');
  with reference do
  try
    Afficher;
  finally
    Free;
  end;
end;

Et là cela doit fonctionner

[erca57]

Mais c'est bien sûr !!!
Je devais être fatigué...
Merci encore Pascal !