Discussion :

[BeanzMaster]

Bonjour à tous,

Pour parfaire mes connaissances, j'ai décidé d'explorer l'utilisation des Interfaces. Je n'utilises quasiment jamais les interfaces dans mes développements. Afin de mieux comprendre le fonctionnement de celles-ci, j'ai fait quelques recherches sur le web et notamment sur les "Design Patterns" (sujet qui ne m'est pas inconnu. J'en ai déjà implanté un certain nombre dans mon framework en PHP.
Mais quid de Delphi ? Je suis donc partie sur de petits exercices simples en commençant par le patron"Observer" (C'est sur ce sujet pour lequel j'ai trouvés le plus d'informations pertinentes sur les "Design patterns" avec Delphi).

Je tiens à préciser que je suis conscient que Delphi utilise déja certain de ces modèles de conception.

Bref tout avait bien commencé dans le meilleur des monde. J'ai créé mes interfaces de base (certain commentaires sont des questions, que je me pose):

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
Const
  IBZOBSERVER_GUID                  = '{6728156B-AF75-4AD6-89DD-9E66F915305F}';
  IIBZOBSERVER_GUID         : TGUID = IBZOBSERVER_GUID;
  IBZOBSERVABLE_GUID                = '{CBA3A188-CCBF-43B2-A877-F9C47F3B4D67}';
  IIBZOBSERVABLE_GUID       : TGUID = IBZOBSERVABLE_GUID;
  IBZOBSERVERSFACTORY_GUID          = '{BC5F2D51-8505-4089-86DC-3752C3F20C3B}';
  IIBZOBSERVERSFACTORY_GUID : TGUID = IBZOBSERVER_GUID;
 
 
Type
  IBZObservable = interface;
 
  { IBZObserver : Interface Observateur }
  IBZObserver = interface [IBZOBSERVER_GUID]
    procedure ExecuteObserver(Observable: IBZObservable);    // Execute une tâche
    procedure AttachToObservable(Observable: IBZObservable); // Attache l'observateur à un sujet
  end;
 
  { IBZObservable : Interface d'un objet, d'un sujet observable par un observateur }
  IBZObservable = interface [IBZOBSERVABLE_GUID]
    procedure AddObserver(Obs: IBZObserver);     // Attache un nouvel observateur
    procedure RemoveObserver(Obs: IBZObserver);  // Supprime un observateur
    procedure NotifyObservers;                   // Notifie tous les observateurs
  end;
 
  { IBZObserversFactory : Est-ce vraiment nécessaire d'avoir une interface de ce type, pour la fabrique ? }
  IBZObserversFactory = interface [IBZOBSERVERSFACTORY_GUID]
    function CreateObserverObject   : IBZObserver;
    function CreateObservableObject : IBZObservable;
  end;

A la suite j'ai créé deux classes de base

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
Type
 
  { TBZCustomObservableObject : Objet implémentant l'interface IBZObservable.
    Cet objet est à surcharger pour pouvoir l'utiliser à des fins précises.
    Cet objet sert de containaire pour les données ou d'états qui pourra ainsi notifier
    les changements de valeur à un ou plusieurs observateurs.
  }
  TBZCustomObservableObject = class(TInterfacedObject, IBZObservable)
    private
      FObservers: TInterfaceList;     // Liste des observateurs
      FObservableRef: IBZObservable;  // sert de référence est ce utile ici ?????
      FOwner : TObject;
      FTag : Integer;                 // Propriété fourre-tout : Tag, TagPointer, TagObjet, TagFloat... Tag tag tag....
    public
      { Création de l'objet observable }
      constructor Create(Observable: IBZObservable); overload;
      constructor Create(AOwner : TObject; Observable: IBZObservable); overload;
      { Destruction de l'objet observable }
      destructor destroy; override;
      { AddObserver : Attache un nouvel observateur }
      procedure AddObserver(Obs: IBZObserver);
      { RemoveObserver : Supprime un observateur }
      procedure RemoveObserver(Obs: IBZObserver);
      { NotifyObservers : Notifie tous les observateurs }
      procedure NotifyObservers;
      { Tag : Propriété fourre-tout }
      property Tag : Integer read FTag write FTag;
      { Propriétaire de l'objet }
      property Owner : TObject read FOwner write FOwner;
  end;
  TBZInterfacedObservableClass = class of TBZCustomObservableObject ;
 
  { TBZCustomObserverObject : Objet observateur Implémentant l'interface IBZObserver
    C'est le sujet observé qui lui notifie lorsque ses proriétés ou son état sont modifiés.
    Cet objet est à surcharger pour pouvoir l'utiliser à des fins précises. Cependant il peut se
    suffir à lui même grâce à son événement OnExecute. Si ce dernier est renseigné alors OnExecute est appelé
    chaque fois que l'observateur doit effectuer une action.
  }
  TBZObserverExecuteEvent = procedure (sender: TObject; anObservable: IBZObservable) of object;
  TBZCustomObserverObject = class(TInterfacedObject, IBZObserver)
    private
      FOwner : TObject;
      FOnExecute : TBZObserverExecuteEvent; // On peut s'en servir dynamiquement
    protected
      FObservableRef : TInterfaceList; //IBZObservable;       // sert de référence
      FObservableRefCount : Integer;
      { ExecuteObserver : Hérité de l'interface IBZObserver }
      procedure ExecuteObserver(Observable: IBZObservable); virtual;
    public
      { Création de l'objet observateur }
      Constructor Create(AOwner : TObject);
      { Destruction de l'objet observateur }
      Destructor Destroy; override;
      { Attache l'observateur à un objet observable }
      procedure AttachToObservable(Observable: IBZObservable); virtual;
      function GetObservableRefCount : Integer;
 
      { OnExecute : Evénement appelé à chaque notification faite par un objet observable avec lequel l'observateur est lié. }
      property OnExecute : TBZObserverExecuteEvent read FOnExecute write FOnExecute;
      { Propriétaire de l'objet }
      property Owner : TObject read FOwner write FOwner;
  end;

Jusque là pas de problèmes. Pour tester j'ai réalisé quelques programmes "bateau" dont le but est de réaliser une simple opération mathématique.
Les deux premiers programmes contiennent 2 TEdit pour entrer des valeurs et 1 TLabel qui contient le résultat de la somme des 2 valeurs.

Pour ce faire j'ai créé un nouvel objet Observable enfant

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
type
  { TBZObservableValue }
 
  TBZObservableValues = class(TBZCustomObservableObject)
  private
    FValue1 : Integer;
    FValue2 : Integer;
    procedure SetValue1(aValue : Integer);
    procedure SetValue2(aValue : Integer);
  public
    property Value1 : Integer read FValue2 write SetValue1;
    property Value2 : Integer read FValue1 write SetValue2;
  end;

Les valeurs de cet objet observable sont misent à jour au travers les événements OnChange des TEdit
Dans mon premier exemple et test (que j'appel les machines) , j'utilise directement "TBZCustomObserverObject" comme observateur et je passe par l'événement OnExecute pour gérer les notifications

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
procedure TBZObservableValues.SetValue1(aValue: Integer);
begin
  if FValue1 = aValue then exit;
  FValue1 := aValue;
  NotifyObservers;
end;
 
procedure TBZObservableValues.SetValue2(aValue: Integer);
begin
  if FValue2 = aValue then exit;
  FValue2 := aValue;
  NotifyObservers;
end;
 
 
procedure TForm1.Edit1Change(Sender: TObject);
begin
 FObservableValues.Value1 := StrToInt(Edit1.Text);
end;
 
procedure TForm1.Edit2Change(Sender: TObject);
begin
 FObservableValues.Value2 := StrToInt(Edit2.Text);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FObservableValues := TBZObservableValues.Create(nil);
  FObserverValue := TBZObserverValue.Create(nil);
  FObserverValue.AttachToObservable(FObservableValues);
  FObserverValue.OnExecute := ObserverExecute;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FObservableValues.RemoveObserver(FObserverValue);
end;
 
procedure TForm1.ObserverExecute(sender: TObject; anObservable: IBZObservable);
var
  LObservable : TBZObservableValues;
begin
  LObservable := anObservable As TBZObservableValues;
  lblResultat.Caption := IntToStr(LObservable.Value1 + LObservable.Value2);
end;

Jusque la tout fonctionne. Mais j'ai un doute sur l'utilisation du AS

Deuxième exemple au lieu d'employé un objet observateur, je donne la possibilité à ma fiche d'être cet observateur

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
type
  TForm1 = class(TForm, IBZObserver)
    Panel1: TPanel;
    lblResultat: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Déclarations privées }
    FObservableObject : IBZObservable;
  protected
    { Déclarations protégées }
    procedure ExecuteObserver(Observable: IBZObservable);
  public
    { Déclarations publiques }
    procedure AttachToObservable(Observable: IBZObservable);
  end;

et je décide également de ne plus passer par l'événement "OnExecute"

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
procedure TForm1.AttachToObservable(Observable: IBZObservable);
begin
  Observable.AddObserver(Self);
end;
 
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  (FObservableObject as TBZMachineObservableValues).Operation := TMathOperations(Combobox1.ItemIndex);
end;
 
procedure TForm1.Edit1Change(Sender: TObject);
begin
  (FObservableObject as TBZMachineObservableValues).Value1 := StrToInt(Edit1.Text);
end;
 
procedure TForm1.Edit2Change(Sender: TObject);
begin
  (FObservableObject as TBZMachineObservableValues).Value2 := StrToInt(Edit2.Text);
end;
 
procedure TForm1.ExecuteObserver(Observable: IBZObservable);
Var
  LObservableObject : TBZMachineObservableValues;
  OpResult : Integer;
  LOp : TMathOperations;
  LOpStr : String;
  LVal1, LVal2 : Integer;
begin
  LObservableObject := Observable As TBZMachineObservableValues;
 
  LVal1 := LObservableObject.Value1;
  LVal2 := LObservableObject.Value2;
  LOp := LObservableObject.Operation;
 
  Case LOp of
    opAdd :
      begin
        OpResult := LVal1 + LVal2;
        LOpStr := ' + ';
      end;
    opSub :
      begin
        OpResult := LVal1 - LVal2;
        LOpStr := ' - ';
      end;
    opMul :
      begin
        OpResult := LVal1 * LVal2;
        LOpStr := ' * ';
      end;
    opDiv :
      begin
        LOpStr := ' / ';
        if LVal2 = 0 then LVal2:=1;
        OpResult := LVal1 div LVal2;
      end;
  end;
  lblResultat.Caption := LVal1.ToString + LOpStr + LVal2.ToString + ' = '  + OpResult.ToString;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
  Try
   FObservableObject := TBZMachineObservableValues.Create(nil);
  finally
    AttachToObservable(FObservableObject);
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FObservableObject.RemoveObserver(Self);
end;

Là également tout va bien.

Pour mon troisième test, je désire observé le résultat de 2 "Machines" et renvoyé la somme de ces deux résultats
La aussi tout est ok avec la mise en place de trois objets observable, d'un seul observateur par machine. Et je conserve l'observateur via ma fiche pour le résultat final

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
  TBZObserverValue = Class(TBZCustomObserverObject)
  protected
    procedure ExecuteObserver(Observable: IBZObservable); override;
  public
    // Pour afficher les résultats  des machine A et B
    Lbl1 : TLabel; 
    Lbl2 : TLabel;
    // Pour afficher le résultat  de  A + B 
    Lbl3 : TLabel;
 
    observable3 : TBZObservableValues; // Contient le résultat des machine A et B
  End;

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
procedure TForm1.FormCreate(Sender: TObject);
begin
  FObservableValues1 := TBZObservableValues.Create(nil);
  FObservableValues1.Tag := 1;
 
  FObservableValues2 := TBZObservableValues.Create(nil);
  FObservableValues2.Tag := 2;
 
  FObservableValues3 := TBZObservableValues.Create(nil);
  FObservableValues3.Tag := 3;
 
  FObserverValue1 := TBZObserverValue.Create(nil);
  FObserverValue1.Lbl1 := lblResultat1;
  FObserverValue1.Lbl2 := lblResultat2;
  FObserverValue1.Lbl3 := lblResultat;
  FObserverValue1.Observable3 := FObservableValues3;
 
  FObserverValue1.AttachToObservable(FObservableValues1);
  FObserverValue1.AttachToObservable(FObservableValues2);
  FObserverValue1.AttachToObservable(FObservableValues3);
end;
 
procedure TForm1.ObserverExecute(sender: TObject; anObservable: IBZObservable);
var
  LObservable : TBZObservableValues;
  LVal1, LVal2 : Integer;
begin
  LObservable := anObservable As TBZObservableValues;
  LVal1 := LObservable.Value1;
  LVal2 := LObservable.Value2;
  if (LObservable.Tag = 1) then
  begin
    lblResultat1.Caption := IntToStr(LVal1 + LVal2);
    FObservableValues3.Value1 := LVal1 + LVal2;
  end
  else if (LObservable.Tag = 2) then
  begin
    lblResultat2.Caption := IntToStr(LVal1 + LVal2);
    FObservableValues3.Value2 := LVal1 + LVal2;
  end
  else
  begin
    lblResultat.Caption := IntToStr(LVal1) +' + '+ IntToStr(LVal2) + ' = ' + IntToStr(LVal1 + LVal2);
  end;
end;
 
{ TBZObserverValue }
 
procedure TBZObserverValue.ExecuteObserver(Observable: IBZObservable);
var
  LObservable : TBZObservableValues;
  LVal1, LVal2 : Integer;
begin
  LObservable := Observable As TBZObservableValues;
  LVal1 := LObservable.Value1;
  LVal2 := LObservable.Value2;
  if (LObservable.Tag = 1) then
  begin
    lbl1.Caption := IntToStr(LVal1 + LVal2);
    Observable3.Value1 := LVal1 + LVal2;
  end
  else if (LObservable.Tag = 2) then
  begin
    lbl2.Caption := IntToStr(LVal1 + LVal2);
    Observable3.Value2 := LVal1 + LVal2;
  end
  else
  begin
    lbl3.Caption := IntToStr(LVal1) +' + '+ IntToStr(LVal2) + ' = ' + IntToStr(LVal1 + LVal2);
  end;
  inherited
end;

;

Là ou cela se gatte c'est pour mon quatrième test
Au lieu de c'ajouter tous les objets directement à ma fiche, j'ai voulu créer un objet décrivant une machine et ai voulu l'étendre grâce à un autre interface

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
 IBZObservableMachineResult = interface
    ['{B04654A9-798F-40E1-BE72-FCC4938978AB}']
    procedure SetOpResult(AValue: Integer);
  end;
 
 TBZCustomMachine = class(TBZCustomObservableObject, IBZObservableMachineResult)
  private
    FObservableValues : IBZObservable; //TBZMachineObservableValues;
    FObserverValues   : IBZObserver; //TBZMachineObserverValues;
 
    FOpResult : Integer;
 
    function GetObservableValues: TBZMachineObservableValues;
    function GetObserverValues: TBZMachineObserverValues;
    procedure SetObservableValues(AValue: TBZMachineObservableValues);
    procedure SetObserverValues(AValue: TBZMachineObserverValues);
 
    procedure SetOpResult(AValue: Integer);
  protected
    procedure DoEditingDoneEdit1(Sender: TObject);
    procedure DoEditingDoneEdit2(Sender: TObject);
    procedure DoComboboxChange(Sender: TObject);
  public
    constructor Create(AOwner : TObject; AnID : Integer); overload;
    destructor Destroy; override;
 
    procedure AttachControl(AEdit1, AEdit2 : TEdit; AOpCombobox : TComboBox);
 
    property ObservableValues :  TBZMachineObservableValues read GetObservableValues write SetObservableValues;
    property ObserverValues :   TBZMachineObserverValues read GetObserverValues write SetObserverValues;
    property OpResult : Integer read FOpResult write SetOpResult;
    property Tag;
  end;
  TBZMachine = TBZCustomMachine;

La fiche :

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
type
  TForm1 = class(TForm, IBZObserver)
    Panel1: TPanel;
    lblResultat1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    Panel2: TPanel;
    lblResultat2: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    ComboBox2: TComboBox;
    lblResultat: TLabel;
    ComboBox3: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
 
  private
    { Déclarations privées }
    FMachineA, FMachineB : TBZMachine;
    FResultatMachine1,  FResultatMachine2 : Integer;
  protected
    { Déclarations protégées }
    procedure ExecuteObserver(Observable: IBZObservable);
  public
    { Déclarations publiques }
    procedure AttachToObservable(Observable: IBZObservable);
  end;

En plus j'ai voulu rajouter des "Fabrique"
Et là paf je me tape une exception le compteur de référence de l'interface IBZObservable me semble être le fautif. est-ce dû la propriété Observable3 ??? Bref c'est certain que ma construction pour l'objet "TBZMachine" est incorrecte mais je n'arrive pas à comprendre pourquoi et comment solutionner le problème. Ou bien c'est à cause de mes "fabriques" ????

Je vous ai mis un petit zip avec toutes les sources. Design Pattern.zip cela sera plus simple

Si des âme charitables passent par là. Et pourrais me corriger en me donnant des explications pour que je puisse comprendre, ça serait cool. Je vous remercie d'avance pour votre aide.

A+

[ShaiLeTroll]

Je regarderais ton ZIP à l'occasion, disons que j'ai un projet motivant à travailler donc moins de temps pour le forum
Les compteurs de ref, c'est souvent un détail d'un rien, une affectation à nil, une weak reference ...


J'utilise pour ma part plutôt la fonction Supports() que l'opérateur as dans le cadre de "Objet -> Interface" ou "Interface -> Interface"
Maintenant, l'opérateur as permet "interface -> object", pour ma part, j'utilisais dans ce une Interface avec une méthode précise retournant un TObject que devait implémenter l'objet mais c'était rarissime.

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
 
  private
    {$IFNDEF XXXX_ORACLE_BY_ADO}
    function GetOraSession(): TOraSession;
    procedure SetOraSession(const Value: TOraSession);
    {$ENDIF XXXX_THOM_ORACLE_BY_ADO}
  public
    ...
 
    // Propriétés
    {$IFNDEF THOM_ORACLE_BY_ADO}
    property OraSession: TOraSession read GetOraSession write SetOraSession;
    {$ENDIF NOT THOM_ORACLE_BY_ADO}
  end;
 
...
 
{$IFNDEF XXXX_ORACLE_BY_ADO}
//------------------------------------------------------------------------------
function TXxxxDBConnection.GetOraSession(): TOraSession;
begin
  if Supports(Self, ISLTDBConnection) then
    Result := (Self.DelegatedConnection as TSLTODACConnectionEngine).Session
  else
    Result := nil;
end;
{$ENDIF NOT XXXX_ORACLE_BY_ADO}

TXxxxDBConnection hérite de TSLTDBConnection

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
 
  /// <summary>Connexion sur une Base de Données d'un Serveur</summary>
  /// <remarks>Veuillez utilisez une variable de type IInterface ou ISLTDBConnection pour garantir une libération par compteur de référence !</remarks>
  TSLTDBConnection = class(TSLTInterfacedReferencableObject, ISLTDBConnection, ISLTDBTransaction, ISLTDBTransactionIsolation, ISLTDBConnectionRemoteDateReader)
  private
    FProvider: IInterface;
    FProviderEngine: ISLTDBProvider;
    FConnection: TObject;
    FOptionalsSupports: TSLTDBGUIDRegistry;
  public
...   
    // Propriétés
    property DelegatedConnection: TObject read FConnection;
  end;
 
...
 
{ TSLTDBConnection }
 
//------------------------------------------------------------------------------
constructor TSLTDBConnection.Create(AProvider: IInterface);
begin
  inherited Create();
 
  FProvider := AProvider;
  if Supports(FProvider, ISLTDBProvider, FProviderEngine) then
    FConnection := FProviderEngine.ConnectionFactory(Self) // retourne un TAggregatedObject
  else
    raise ESTLIntfCastError.Create(FProvider, ISLTDBProvider); // Pseudo-Assert Exception !
 
  FOptionalsSupports := TSLTDBGUIDRegistry.Create();
  FOptionalsSupports.RegisterGUID(ISLTDBTransaction);
  FOptionalsSupports.RegisterGUID(ISLTDBTransactionIsolation);
  FOptionalsSupports.RegisterGUID(ISLTDBConnectionRemoteDateReader);
end;

Le code ci-dessus c'est pour un code bien précis mais je l'ai rendu générique via ISLTInterfaceWithDelphiImplementation

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
 
  /// <summary>Fourni un accès à la classe d'implémentation Delphi</summary>
  /// <remarks>Le "Transtypage des références d'interfaces en objets" n'est possible que depuis la version 2010 !
  /// <para>En Delphi 7, il est possible d'obtenir :</para>
  /// <para>- l'équivalent d'un opérateur "is" de la forme "intf is class" en ajoutant l'accès à une propriété "ClassType: TClass" et en utilisant "intf.ClassType.InheritsFrom(class)"</para>
  /// <para>- l'équivalent d'un opérateur "as" de la forme "intf as class" en ajoutant l'accès à une propriété "MySelf: TObject" et en utilisant "intf.MySelf as class"</para>
  /// <para>Le MySelf est une pratique intéressante aussi pour le "with T.Create do" où l'on a pas de variable et que l'on souhaite passer en paramètre l'objet à une méthode.</para></remarks>
  ISLTInterfaceWithDelphiImplementation = interface
    ['{CA47112F-AC3B-4E32-959C-D9129951C9BC}']
 
    // Accesseurs
    function GetDelphiClassType(): TClass;
    function GetDelphiInstance(): TObject;
 
    // Propriétés
    property ClassType: TClass read GetDelphiClassType;
    property MySelf: TObject read GetDelphiInstance;
  end;

et justement le seul qui l'utilise c'est la même classe qui implémente le ConnectionFactory ci-dessus

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
  /// <summary>Provider ODAC pour Oracle</summary>
  TSLTODACProviderEngine = class(TSLTDBProviderAbstractEngine, ISLTDBProvider)
  private
    // Accesseurs - Implémentation de ISLTInterfaceWithDelphiImplementation
    function GetDelphiClassType(): TClass;
    function GetDelphiInstance(): TObject;
 
    // Méthodes - Implémentation de ISLTDBProvider
    function ConnectionFactory(const ConnectionController: IInterface): TAggregatedObject;
  public
    // Méthodes - Implémentation des méthodes abstraites de TSLTDBProviderAbstractEngine
    class function FriendlyName(): string; override;
  end;

Je me suis intéressé plus à la différence entre le C++Builder et Delphi : Interface dont l'implémentation est réparti dans plusieurs classes puis [C++\Delphi] Interface, Héritage et Supports !

Note que j'utilise des TAggregatedObject ou voire mes propres ancêtre TSLTInterfacedObject ou TSLTInterfacedReferencableObject pour justement adapter la gestion du compteur de référence

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
  /// <summary>la classe TSLTInterfacedReferencableObject inhibe (au besoin) le compteur de référence du TInterfacedObject</summary>
  /// <remarks><para>la classe TSLTInterfacedReferencableObject peut être utilisée pour que certaines implémentations d'interfaces soit disponible en accès direct par référence d'objet au lieu de passer par une référence d'interface,
  /// si l'instance est conservé via une référence d'interface, cela s'utilise exactement comme une interface IInterface implémentée par TInterfacedObject,
  /// si l'instance est utilisé via une référence d'objet, cela s'utilise comme TObject.</para>
  /// <para>Il n'est pas conseillé d'utiliser TSLTInterfacedReferencableObject en classe de base d'une implémentation en délégation que cela soit en type classe ou en type interface,
  /// la classe ancêtre TAggregatedObject fournie par la RTL ou la classe ancêtre TSLTInterfacedObject fournie par la SLT sont plus appropriées et toutes les deux compatibles avec TSLTInterfacedObjectFactory.</para>
  /// <para>Lorque le compteur de référence est désactivé, il est obligatoire de conserver l'instance de l'objet au lieu de conserver la référence de l'interface et de gérer explicitement la libération de l'objet</para></remarks>
  TSLTInterfacedReferencableObject = class(TInterfacedObject, IInterface)
  private
    // Membres privés
    FIsAfterConstruction: Boolean;
    FNoReferenceCouting: Boolean;
  protected
    // Accesseurs
    procedure SetNoReferenceCouting(const Value: Boolean);
 
    { IInterface special implementation }
    function _AddRef(): Integer; stdcall;
    function _Release(): Integer; stdcall;
 
  public
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
 
    // Propriétés
    property NoReferenceCouting: Boolean read FNoReferenceCouting write SetNoReferenceCouting;
  end;

Tiens, je crois que le seul cas où c'est en pratique c'est pour justement une délégation de gestionnaire d'évènement, ce qui ne doit pas être loin d'une pattern Observable en très simplifié

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
//---------------------- TMonitorPropertyValueEventProxy -----------------------
type
  TMonitorPropertyValueEventProxy = class(TSLTInterfacedReferencableObject, ISLTPersistentEventHandler)
  private
    FSender: TObject;
    FValue: ISLTDBEntityPropertyValue;
    FPropertyValueChangeEventHandler: TSLTDBEntityPropertyValueChangeEvent;
    procedure DoPropertyValueChange();
  public
    constructor Create(Sender: TObject; AValue: IInterface; APropertyValueChangeEventHandler: TSLTDBEntityPropertyValueChangeEvent);
    destructor Destroy(); override;
    procedure HandleEvent(AEvent: ISLTPersistentEvent);
  end;

Une chose que j'utilise aussi beaucoup c'est la délégation d'implémentation !
Cela te permet depuis une classe de supporter toutes les interfaces nécessaires mais de diviser ta classe en plusieurs, au final, ta classe est un agrégat, plus facile à maintenir, plus facile à tendre à un couplage faible entre les objets pour permettre une substitution d'une implémentation par une autre

C'est aussi très utile pour que ton objet puisse implémenter l'interface sans devoir copier du code, l'agrégat/délégation est disons la version propre du multi-héritage

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 
  /// <summary>Objet de base pour les objets supportant une persistance</summary>
  /// <remarks>La classe TSLTPersistent doit être utilisée de préférence via l'interface ISLTPersistent.</remarks>
  /// <remarks>La classe TSLTPersistent peut-être héritée et ses méthodes d'implémentation redéfinies.</remarks>
  /// <remarks>La classe TSLTPersistent peut-être utilisée via une simple composition et dans ce cas : il est nécessaire d'affecter, à la propriété
  /// PublishedPropertiesDescriptor, la classe d'objet contenant des propriétés publiées accessibles en RTTI.
  /// L'approche par composition avec une encapsulation totale permet un couplage faible entre votre code métier et l'utilisation de cette implémentation de persistance,
  /// vous pourrez ainsi par la suite fournir vos implémentations personnalisées ou remplacer totalement cette bibliothèque par une autre bibliothèque répondant au mieux à vos besoins.</remarks>
  /// <remarks>En modifiant les accesseurs ou fabriques des classes gérant les Délégation,
  /// vous pouvez fournir votre implémentation personnalisée de ISLTPersistentFactories,
  /// ainsi que d'autres implémentations personnalisées des interfaces que vous jugerez nécessaire à votre objet.</remarks>
  /// <remarks>La classe TSLTPersistent n'est pas obligatoire, vous pouvez créer votre propre ancêtre persistant tant qu'il implémente correctement ISLTPersistentPropertiesMetaData et ISLTPersistentPropertiesData,
  /// votre propre ancêtre persistant peut fournir sa propre implémentation de ISLTPersistentFactories vous permettant de substituer l'ensemble des implémentations par défaut par des implémentations personnalisées</remarks>
  TSLTPersistent = class(TSLTInterfacedObject, ISLTPersistent, ISLTPersistentRTTIAccess, ISLTPersistentFactories, ISLTPersistentPropertiesMetaData, ISLTPersistentPropertiesData,
    ISLTPersistentNullablePropertyKindRegistry, ISLTPersistentPropertyByIndexAccessors, ISLTPersistentNullablePropertyByIndexAccessors, ISLTPersistentVariantPropertyByIndexAccessors, ISLTPersistentSpecialPropertyByIndexAccessors,
    ISLTPersistentMarshalling, ISLTPersistentMarshallable, ISLTPersistentSetCountable, ISLTPersistentLoadStateInspector)
  strict private
    // Membres privés de Classe
    class var
      FDefaultFactoriesClass: TClass;
 
  public
    // Types publiques
    type
      TDelegate = (dFactories, dPropertiesMetaData, dPropertiesData, dPbIAccess, dNPbIAccess, dVPbIAccess, dSPbIAccess, dNPKindRegistry);
      TDelegates = set of TDelegate;
      IDelegatedInterface = IInterface;
      PDelegatedInterface = ^IDelegatedInterface;
      TDelegatedInterfaces = array[TDelegate] of IDelegatedInterface;
      PDelegatedInterfaces = ^TDelegatedInterfaces;
      TStaticDelegatedInterfaces = class(System.Generics.Collections.TDictionary<TClass, PDelegatedInterfaces>)
      private
        function GetDelegate(const Key: TClass): PDelegatedInterfaces;
      protected
        procedure ValueNotify(const Value: PDelegatedInterfaces; Action: TCollectionNotification); override;
      public
        property Delegates[const Key: TClass]: PDelegatedInterfaces read GetDelegate; default;
      end;
    const
      STATIC_DELEGATES: TDelegates = [TDelegate.dFactories, TDelegate.dPropertiesMetaData, TDelegate.dNPKindRegistry];
  strict protected
    // Membres protégés
    FMappedClass: TClass;
    FRTTIAccess: TSLTPersistentRTTIAccess;
    FMarshalling: TSLTPersistentMarshalling;
 
    // Membres privés pour les délégations
    FDelegatedIntf: TDelegatedInterfaces;
 
  strict private
    // Membres privés statiques pour les délégations
    class var
      FStaticDelegatedIntf: TStaticDelegatedInterfaces;
  protected
    // Accesseurs - Implementation de ISLTPersistent
    function GetPublishedPropertiesDescriptor(): TClass; virtual;
    procedure SetPublishedPropertiesDescriptor(const Value: TClass); virtual;
    // Accesseurs - Implementation de ISLTPersistentLoadStateInspector
    function GetLoaded(): Boolean;
    procedure SetLoaded(const Value: Boolean);
    // Accesseurs - Implémentation de ISLTPersistentSetCountable
    function GetPersistentCount(): Integer;
    function GetPersistentActiveNumber(): Integer;
    // Accesseurs redéfinissables
    function GetDelegatedInterfaceStorage(): PDelegatedInterfaces; virtual;
    function GetStaticDelegatedInterfaceStorage(): PDelegatedInterfaces; virtual;
    function GetDelegatedInterface(Index: TDelegate): PDelegatedInterface; virtual;
    function GetFactoriesClass(): TClass; virtual;
    // Accesseurs redéfinissables pour délégation
    function GetFactories(): ISLTPersistentFactories; virtual;
    function GetPropertiesMetaData(): ISLTPersistentPropertiesMetaData; virtual;
    function GetPropertiesData(): ISLTPersistentPropertiesData; virtual;
    function GetPropertyByIndexAccessors(): ISLTPersistentPropertyByIndexAccessors; virtual;
    function GetNullablePropertyByIndexAccessors(): ISLTPersistentNullablePropertyByIndexAccessors; virtual;
    function GetVariantPropertyByIndexAccessors(): ISLTPersistentVariantPropertyByIndexAccessors; virtual;
    function GetSpecialPropertyByIndexAccessors(): ISLTPersistentSpecialPropertyByIndexAccessors; virtual;
    function GetNullablePropertyKindRegistry(): ISLTPersistentNullablePropertyKindRegistry; virtual;
    function GetMarshalling(): TSLTPersistentMarshalling; virtual;
    function GetMarshallable(): ISLTPersistentMarshallable; virtual;
    // Méthodes redéfinissables
    procedure RegisterNullableInterfaces(); virtual;
 
    // Propriétés
    // Gestionnaire des Interfaces pour délégation
    property DelegatedInterfaceStorage: PDelegatedInterfaces read GetDelegatedInterfaceStorage;
    property StaticDelegatedInterfaceStorage: PDelegatedInterfaces read GetStaticDelegatedInterfaceStorage;
    property DelegatedInterfaces[Index: TDelegate]: PDelegatedInterface read GetDelegatedInterface;
    property FactoriesClass: TClass read GetFactoriesClass;
    // Délégation à une propriété de type interface
    property Factories: ISLTPersistentFactories read GetFactories implements ISLTPersistentFactories;
    property PropertiesMetaData: ISLTPersistentPropertiesMetaData read GetPropertiesMetaData implements ISLTPersistentPropertiesMetaData;
    property PropertiesData: ISLTPersistentPropertiesData read GetPropertiesData implements ISLTPersistentPropertiesData;
    property PropertyByIndexAccessors: ISLTPersistentPropertyByIndexAccessors read GetPropertyByIndexAccessors implements ISLTPersistentPropertyByIndexAccessors;
    property NullablePropertyByIndexAccessors: ISLTPersistentNullablePropertyByIndexAccessors read GetNullablePropertyByIndexAccessors implements ISLTPersistentNullablePropertyByIndexAccessors;
    property VariantPropertyByIndexAccessors: ISLTPersistentVariantPropertyByIndexAccessors read GetVariantPropertyByIndexAccessors implements ISLTPersistentVariantPropertyByIndexAccessors;
    property SpecialPropertyByIndexAccessors: ISLTPersistentSpecialPropertyByIndexAccessors read GetSpecialPropertyByIndexAccessors implements ISLTPersistentSpecialPropertyByIndexAccessors;
    property NullablePropertyKindRegistry: ISLTPersistentNullablePropertyKindRegistry read GetNullablePropertyKindRegistry implements ISLTPersistentNullablePropertyKindRegistry;
    property Marshallale: ISLTPersistentMarshallable read GetMarshallable implements ISLTPersistentMarshallable;
    // Délégation à une propriété de type classe
    property RTTIAccess: TSLTPersistentRTTIAccess read FRTTIAccess implements ISLTPersistentRTTIAccess;
    property Marshalling: TSLTPersistentMarshalling read GetMarshalling implements ISLTPersistentMarshalling;
 
    // Propriétés d'interface redéfinies à usage interne et pour les classes héritées
    property PublishedPropertiesDescriptor: TClass read GetPublishedPropertiesDescriptor write SetPublishedPropertiesDescriptor;
  public
    // Constructeurs de Classe
    class constructor Create();
    class destructor Destroy();
 
    // Fabrique
    class function PersistentFactory(AClass: TClass): IInterface; virtual;
 
    // Propriétés de Classe
    /// <summary>Indique la classe par défaut utilisée comme Implémentation de ISLTPersistentFactories</summary>
    class property DefaultFactoriesClass: TClass read FDefaultFactoriesClass write FDefaultFactoriesClass;
  public
    // Constructeurs
    constructor Create(const AController: IInterface = nil); override;
    destructor Destroy(); override;
  end;
 
 
    /// <summary>Objet de base pour les Entités mappant un enregistrement d'une Table d'une DB selon un mécanisme de Mapping Objet-Relationnel (en anglais Object-Relational Mapping = ORM)</summary>
  TSLTPersistentORMEntity = class(TSLTPersistent, ISLTPersistentORMEntity, ISLTPersistentORMEntityFactories,
    ISLTPersistentORMEntityPropertiesMetaData, ISLTPersistentORMEntitySpecialPropertyByIndexAccessors,
    ISLTPersistentORMDBMarshallable,
    ISLTPersistentORMEntityDataSetProxy)
  strict private
    // Membres privés de Classe
    class var
      FDefaultFactoriesClass: TClass;
  public
    // Types publiques
    type
      TDelegateORM = (doFirstTDelegate = Ord(Low(TSLTPersistent.TDelegate)), doSPbIAccess = Succ(Ord(High(TSLTPersistent.TDelegate))));
      TDelegatedORMInterfaces = array[TDelegateORM] of TSLTPersistent.IDelegatedInterface;
      PDelegatedORMInterfaces = ^TDelegatedORMInterfaces;
  strict private
    // Membres privés pour les délégations
    FDelegatedIntf: TDelegatedORMInterfaces;
  strict private
    // Membres privés statiques pour les délégations
    class var
      FStaticDelegatedIntf: TSLTPersistent.TStaticDelegatedInterfaces;
  private
    // Membres privés
    FConnection: ISLTDBConnection;
 
  protected
    // Accesseurs - Implémentation de ISLTPersistentORMEntity
    function GetConnection(): ISLTDBConnection;
    procedure SetConnection(const Value: ISLTDBConnection);
 
  protected
    // Accesseurs redéfinis
    function GetDelegatedInterfaceStorage(): TSLTPersistent.PDelegatedInterfaces; override;
    function GetStaticDelegatedInterfaceStorage(): TSLTPersistent.PDelegatedInterfaces; override;
    function GetFactoriesClass(): TClass; override;
    function GetMarshalling(): TSLTPersistentMarshalling; override;
 
    // Accesseurs redéfinissables
    function GetORMFactories(): ISLTPersistentORMEntityFactories; virtual;
    function GetORMPropertiesMetaData(): ISLTPersistentORMEntityPropertiesMetaData; virtual;
    function GetDelegatedORMInterface(Index: TDelegateORM): TSLTPersistent.PDelegatedInterface; virtual;
 
    // Accesseurs redéfinissables pour délégation
    function GetORMSpecialPropertyByIndexAccessors(): ISLTPersistentORMEntitySpecialPropertyByIndexAccessors; virtual;
    function GetORMMarshallable(): ISLTPersistentORMDBMarshallable; virtual;
    function GetORMDataSetProxy(): ISLTPersistentORMEntityDataSetProxy; virtual;
 
    // Méthodes redéfinissables
    procedure RegisterNullableInterfaces(); override;
 
    // Propriétés
    // Gestionnaire des Interfaces pour délégation
    property DelegatedORMInterfaces[Index: TDelegateORM]: TSLTPersistent.PDelegatedInterface read GetDelegatedORMInterface;
    // Délégation à une propriété de type interface
    property ORMFactories: ISLTPersistentORMEntityFactories read GetORMFactories implements ISLTPersistentORMEntityFactories;
    property ORMPropertiesMetaData: ISLTPersistentORMEntityPropertiesMetaData read GetORMPropertiesMetaData implements ISLTPersistentORMEntityPropertiesMetaData;
    property ORMSpecialPropertyByIndexAccessors: ISLTPersistentORMEntitySpecialPropertyByIndexAccessors read GetORMSpecialPropertyByIndexAccessors implements ISLTPersistentORMEntitySpecialPropertyByIndexAccessors;
    property ORMMarshallable: ISLTPersistentORMDBMarshallable read GetORMMarshallable implements ISLTPersistentORMDBMarshallable;
    property ORMDataSetProxy: ISLTPersistentORMEntityDataSetProxy read GetORMDataSetProxy implements ISLTPersistentORMEntityDataSetProxy;
  public
    // Constructeurs de Classe
    class constructor Create();
    class destructor Destroy();
 
    // Fabrique
    class function EntityFactory(AClass: TClass): IInterface; virtual;
 
    // Propriétés de Classe
    /// <summary>Indique la classe utilisée comme Implémentation de ISLTPersistentFactories adaptée aux Entités mappant un enregistrement d'une Table d'une DB selon un mécanisme de Mapping Objet-Relationnel</summary>
    class property DefaultFactoriesClass: TClass read FDefaultFactoriesClass write FDefaultFactoriesClass;
  end;

[BeanzMaster]

Merci pour tes explications ShaiLeTroll je vais essayé de comprendre tes exemples. Petite question qu'est ce qu'une weak reference ?

J'ai lu que l'utilisation du AS justement modifiait le compteur de références. Je vais essayer de faire quelques modifications et utiliser Support comme tu me le suggère.

je vais regardé tes explications d'un peu plus près pour comprendre.

Si non je pensais surchargé _addRef, _Realase et QueryInterface dans ce genre là et voir si cela marche

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
function TBZInterfacedPersistent._AddRef: Integer; {$IFDEF WINDOWS} stdcall; {$ElSE} CDecl; {$Endif}
begin
  Result := -1; // ignore
end;
 
function TBZInterfacedPersistent._Release: Integer; {$IFDEF WINDOWS} stdcall; {$ElSE} CDecl; {$Endif}
begin
  Result := -1; // ignore, ou  Result := 0; ??? à voir
end;
 
function TBZInterfacedPersistent.QueryInterface(constref IID: TGUID; out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;
 
  { TBZUpdateAbleObject : Classe abstraite décrivant l'interface "IBZNotifyAble"
    Offre un systeme et d'evenement de notifications, qui donne  la capacité de notifer
    les changements de valeurs des propriétés à d'autres classes. }
  TBZUpdateAbleObject = Class(TBZInterfacedPersistent, IBZNotifyAble)

Le code ci-dessus est une technique qui est utilsé dans GLScene pour notifier les changements d'état à l'objet parent et ou un événement "OnChange" peut-être utilisé pour intercepter la notification.

J'essayerai tout ça demain, là j'en ai un peu marre.

Merci encore

Bonne fin de soirée

[anapurna]

salut

tu n'aurais pas un petit soucis ici aussi ?

Code :

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

1
2
3
4
5
6
 
   for  i := 0 to FObservableRefCount-1 do
  begin
    IBZObservable(FObservableRef.Items[i]).RemoveObserver(Self);
    FObservableRef.Delete(i);
  end;

pour la suppression il est preferable de partir du plus haut vers le plus bas

Code :

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

1
2
3
4
5
6
 
   for  i := FObservableRefCount-1 Downto  0 do
  begin
    IBZObservable(FObservableRef.Items[i]).RemoveObserver(Self);
    FObservableRef.Delete(i);
  end;

sinon tu risque des fuite de mémoire et de ne pas tout libérer ainsi que des dépassement de capacité

[BeanzMaster]

Bonsoir Anapurna

tu as tout as fait raison. Je fais toujours la même bêtise sur ce genre de libération. J'oublie tout le temps qui faut mieux partir d'en haut Ce n'est pas la première fois que tu me fais la remarque la dessus . Ici j'ai de la chance il n'y a pas 10 000 objets

Merci

Bonne soirée

[ALWEBER]

Bonjour,
Ce qu'il faut retenir des interfaces c'est l'obligation d'implémenter les descriptions décrites dans les interfaces. Si tu es en pur pascal objet cela n'a pas grand sens puisque tu as normalement la visibilité de toutes les classes de ton projet. Cela par contre a un sens soit en c++ soit en java ou les paradigmes de programmation sont différents et ce qui est quand même le cas pour des cibles comme Androïd. Il y a eu une belle présentation en Hollande organiée par Barnsten l'année dernière sur ce sujet. je vais la retrouver et la rendre accessible. J'ai retrouvé aussi la présentation qui en est faite dans le manuel de programmation objet de Delphi 5 et est fort interessante. l'Interface était essentiellement utilisée à l'époque avec les process COM/DCOM de Microsoft.
A titre d'exemple j'ai reproduit ce qui est proposé dans l'aide Delphi sur le pattern observer ce qui est a mon sens sans intérêt puisque on peut faire la même chose avec des évènements.(Idem avec le singleton qui peut être remplacé par une utilisation judicieuse des "Class FUnction" et autres. Mais si quelqu'un veut enrichir la discussion je suis preneur et je ne détiens pas la Vérite avec un grand V

[BeanzMaster]

Bonsoir ALWEBER,

Je suis d'accord avec toi sur le pattern observer on peux largement s'en passer et tout gérer par les événements. Sauf certain cas, ou cela peut s'avérer vraiment utile. Comme afficher des données de différentes manières dans des fenêtres secondaire par exemple. La moindre modification des données dans la fiche principale se répercutera automatiquement dans les autres. La gestion du flux de données devient "transparente" et peut-être mise en place avec beaucoup de moins de code. Bref , Je cherche surtout à comprendre le fonctionnement des interfaces. Elles vont m'être utiles pour une bibliothèque graphique (GLScene se fait vieux, il aurait besoin d'un coup de boost) et d'autres projets.
Pour une interaction avec des objets graphique, entre autres, le pattern observer peux devenir intéressant et rentable pour économiser du code. (du moins en théorie dans ma tête).

Et oui, les interfaces à la base sont une invention de Windows pour pouvoir accéder aux COM si je ne me trompe pas.

Je suis partie des "design pattern" comme source d'exercice. Mais il ne faut pas oublier que les "Design Pattern" ne sont pas une finalité dans un programme. Ces "modèles de programmation" même en pascal on leurs utilité. Dans Delphi (et Lazarus) il existe déja un bon nombre de composants et mécanismes basé sur les recommandations des "modèles de conception". On les utilises sans même s'en rendre compte. Une classe avec des procédure c'est quoi ? Ben c'est simplement le patron de conception "Command".

Les interfaces ne sont qu'un moyen, un genre de contrat pour uniformiser des classes d'objet. Savoir les utiliser a bon escient peut-être une force dans une bibliothèque pour pouvoir l'améliorer et la maintenir à moindre coût. Les interfaces peuvent devenir un atout. Mais je me trompe peut-être la-dessus. Je n'ai peut-être pas tout compris correctement. En gros c'est comme cela que je m'imagine la chose. Et c'est le pourquoi je cherche à les assimiler.

Et idem je suis preneur d'infos sur le sujet et ou de sources complètes à étudier.

Merci

Bonne nuit

[anapurna]

salut

l'interface permet aussi par exemple d'utiliser des plugin permettant l’accès à des donnés fait dans un autre langage
paul toth en as parlé dans son livre delphi 7 (je sais c'est pas tout jeune)
Nick Hodges dans son implementation du modele observer avec interface donnes une bonne utilisation et confirme ce que vient de dire BeanzMaster sur les possibilité d'utilisation.

je ne suis pas friand des interface mais je peux reconnaître leur utilité dans certain cas

[ShaiLeTroll]

Merci pour tes explications ShaiLeTroll je vais essayé de comprendre tes exemples. Petite question qu'est ce qu'une weak reference ?

si non je pensais surchargé _addRef, _Realase et QueryInterface dans ce genre là et voir si cela marche

une weak reference c'est soit une gestion sans compteur soit le stockage de la référence dans un pointeur pour que le compteur ne soit pas modifier

Et pour la surcharge, voici mes classes de base, tu as la variante weak reference pointeur (TSLTInterfacedObject) et la variante par inhibition du compteur (TSLTInterfacedReferencableObject)

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Copyright "SLT Solutions", (©2006)                                         -
 *                                                                             -
 *  contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2    -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *  contributeur : ShaiLeTroll (2013) - Actualisation des compilateurs         -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit SLT.Common.SystemEx;
 
interface
 
uses System.SysUtils;
 
{$IF DECLARED(GPL)}
{$MESSAGE HINT 'La SLT (SoLuTions Libraries and Tools) est régi par la licence CeCILL-C compatible avec la licence GNU GPL,'}
{$MESSAGE HINT 'Par contamination, une version modifiée de la SLT incluant des éléments GPL ou une version intégrée dans un sous-ensemble d''éléments GPL devra être redistribué sous licence GPL.'}
{$IFEND}
 
type
  { Forward class declarations }
  TSLTInterfacedObject = class;
  ISLTInterfaceWithDelphiImplementation = interface;
  TSLTInterfacedObjectFactory = class;
 
  /// <summary>Erreur de base liée au TSLTInterfacedObject</summary>
  ESLTInterfacedObject = class(Exception);
  /// <summary>Erreur de base liée au TSLTInterfacedReferencableObject</summary>
  ESLTInterfacedReferencableObjectError = class(ESLTInterfacedObject);
 
  /// <summary>la classe TSLTInterfacedObject est une fusion entre un TInterfacedObject et TAggregatedObject</summary>
  /// <remarks>TSLTInterfacedObject peut être instancié comme un simple objet d'implémentation ou comme partie d'un agrégat.
  /// <para>On considère un "simple objet d'implementation" lorsque l'on utilise l'objet UNIQUEMENT via des interfaces,
  /// ceci est valable pour toute utilisation ou composition par Interface y compris le "implements" pour "Délégation à une propriété de type interface".
  /// L'utilisation systématique par interface garanti un couplage faible, il est vivement recommandé</para>
  /// <para>On considère comme "partie d'un agrégat" lorsque l'on utilise une référence sur l'instance de l'objet,
  /// c'est à dire lors d'un couplage fort ou de l'utilisation du "implements" pour "Délégation à une propriété de type classe" </para>
  /// <para>Les méthodes IInterface sont implémentées dans TSLTInterfacedObject pour gérer l'agrégation en déléguant de manière appropriée à l'interface contrôleur quand l'objet instancié est l'objet interne d'un agrégat.
  /// De ce fait, pour toutes les interfaces implémentées dans l'objet interne,
  /// le compteur de références n'est pas directement affecté quand une référence d'interface est créée au profit du compteur de références du contrôleur.</para></remarks>
  /// <remarks>TSLTInterfacedObject est inspiré du ComObj.TComObject de Delphi 5 sans de lien avec la couche COM de Microsoft.</remarks>
  TSLTInterfacedObject = class(TInterfacedObject, IInterface)
  private
    // Membres privés
    FController: Pointer;  // weak reference to controller
  protected
    // Accesseurs
    function GetController(): IInterface; virtual;
    procedure SetController(const Value: IInterface); virtual;
 
    { IInterface special implementation }
    function IInterface.QueryInterface = InheritedQueryInterface;
    function IInterface._AddRef = InheritedAddRef;
    function IInterface._Release = InheritedRelease;
    { IInterface methods for other interfaces use another implementation in herited classes }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
 
    { IInterface special implementation - redéfinissables }
    function InheritedAddRef: Integer; virtual; stdcall;
    function InheritedQueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function InheritedRelease: Integer; virtual; stdcall;
  public
    // Constructeurs
    /// <summary>la classe TSLTInterfacedObject propose un constructeur virtuel dans le but de gérer un polymorphisme
    /// lorsque l'on le couple à la fabrique TSLTInterfacedObjectFactory </summary>
    /// <param name="AController">Vous devez fournir un contrôleur si vous conserver l'instance via sa référence d'objet dans le cadre d'une "Délégation à une propriété de type classe",
    /// si vous utilisez une référence d'interface et non une référence d'objet, laisser ce paramètre à sa valeur par défaut</param>
    constructor Create(const AController: IInterface = nil); virtual;
    procedure BeforeDestruction(); override;
 
    // Propriétés
    property Controller: IInterface read GetController write SetController;
  end;
 
  /// <summary>la classe TSLTInterfacedReferencableObject inhibe (au besoin) le compteur de référence du TInterfacedObject</summary>
  /// <remarks><para>la classe TSLTInterfacedReferencableObject peut être utilisée pour que certaines implémentations d'interfaces soit disponible en accès direct par référence d'objet au lieu de passer par une référence d'interface,
  /// si l'instance est conservé via une référence d'interface, cela s'utilise exactement comme une interface IInterface implémentée par TInterfacedObject,
  /// si l'instance est utilisé via une référence d'objet, cela s'utilise comme TObject.</para>
  /// <para>Il n'est pas conseillé d'utiliser TSLTInterfacedReferencableObject en classe de base d'une implémentation en délégation que cela soit en type classe ou en type interface,
  /// la classe ancêtre TAggregatedObject fournie par la RTL ou la classe ancêtre TSLTInterfacedObject fournie par la SLT sont plus appropriées et toutes les deux compatibles avec TSLTInterfacedObjectFactory.</para>
  /// <para>Lorque le compteur de référence est désactivé, il est obligatoire de conserver l'instance de l'objet au lieu de conserver la référence de l'interface et de gérer explicitement la libération de l'objet</para></remarks>
  TSLTInterfacedReferencableObject = class(TInterfacedObject, IInterface)
  private
    // Membres privés
    FIsAfterConstruction: Boolean;
    FNoReferenceCouting: Boolean;
  protected
    // Accesseurs
    procedure SetNoReferenceCouting(const Value: Boolean);
 
    { IInterface special implementation }
    function _AddRef(): Integer; stdcall;
    function _Release(): Integer; stdcall;
 
  public
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
 
    // Propriétés
    property NoReferenceCouting: Boolean read FNoReferenceCouting write SetNoReferenceCouting;
  end;
 
  /// <summary>Référence de classe sur TSLTInterfacedObject</summary>
  TSLTInterfacedObjectClass = class of TSLTInterfacedObject;
 
  /// <summary>Référence de classe sur TAggregatedObject</summary>
  TAggregatedObjectClass = class of TAggregatedObject;
 
  /// <summary>Fabrique d'implementation d'interface supportant l'utilisation d'une classe de base TObject, TInterfacedObject, TAggregatedObject ou TSLTInterfacedObject</summary>
  TSLTInterfacedObjectFactory = class(TObject)
  public
    // Méthodes de Classe
    class procedure IntfFactory(const AClass: TClass; const IID: TGUID; out Intf; const AController: IInterface = nil);
  end;
 
  /// <summary>Fourni un accès à la classe d'implémentation Delphi</summary>
  /// <remarks>Le "Transtypage des références d'interfaces en objets" n'est possible que depuis la version 2010 !
  /// <para>En Delphi 7, il est possible d'obtenir :</para>
  /// <para>- l'équivalent d'un opérateur "is" de la forme "intf is class" en ajoutant l'accès à une propriété "ClassType: TClass" et en utilisant "intf.ClassType.InheritsFrom(class)"</para>
  /// <para>- l'équivalent d'un opérateur "as" de la forme "intf as class" en ajoutant l'accès à une propriété "MySelf: TObject" et en utilisant "intf.MySelf as class"</para>
  /// <para>Le MySelf est une pratique intéressante aussi pour le "with T.Create do" où l'on a pas de variable et que l'on souhaite passer en paramètre l'objet à une méthode.</para></remarks>
  ISLTInterfaceWithDelphiImplementation = interface
    ['{CA47112F-AC3B-4E32-959C-D9129951C9BC}']
 
    // Accesseurs
    function GetDelphiClassType(): TClass;
    function GetDelphiInstance(): TObject;
 
    // Propriétés
    property ClassType: TClass read GetDelphiClassType;
    property MySelf: TObject read GetDelphiInstance;
  end;
 
/// <remarks>The CompilerVersion constant was introduced in Delphi 6 along with conditional expressions.
/// You can use CompilerVersion in $IF expressions to test the compiler version level
/// <para>Example:  {$IF CompilerVersion >= CompilerVersionXE2} ... {$IFEND} </para></remarks>
const
  CompilerVersionXE5 = 26.0;
  CompilerVersionXE4 = 25.0;
  CompilerVersionXE3 = 24.0;
  CompilerVersionXE2 = 23.0;
  CompilerVersionXE = 22.0;
  CompilerVersion2010 = 21.0;
  CompilerVersion2009 = 20.0;
  CompilerVersion2007 = 18.5;
  CompilerVersion2006 = 18.0;
  CompilerVersion2005 = 17.0;
  CompilerVersion8 = 16.0;
  CompilerVersion7 = 15.0;
  CompilerVersion6 = 14.0;
 
implementation
 
uses SLT.Common.SysUtilsEx;
 
const
  ERR_CANT_DISABLE_COUTING_REFERENCE = 'Impossible de désactiver le compteur de référence pour cet objet interfacé ne pouvant pas devenir référencable';
 
 
{ TSLTInterfacedObject }
 
//------------------------------------------------------------------------------
procedure TSLTInterfacedObject.BeforeDestruction();
begin
  try
    inherited BeforeDestruction();
  except
    on E: Exception do
      raise ExceptClass(E.ClassType).CreateFmt('%s : %s', [Self.ClassName(), E.Message]);
  end;
end;
 
//------------------------------------------------------------------------------
constructor TSLTInterfacedObject.Create(const AController: IInterface = nil);
begin
  inherited Create();
 
  Controller := AController;
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject.GetController(): IInterface;
begin
  Result := IInterface(FController);
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject.InheritedAddRef(): Integer;
begin
  Result := inherited _AddRef();
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject.InheritedQueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := inherited QueryInterface(IID, Obj);
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject.InheritedRelease(): Integer;
begin
  Result := inherited _Release();
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if Assigned(FController) then
    Result := IInterface(FController).QueryInterface(IID, Obj)
  else
    Result := InheritedQueryInterface(IID, Obj);
end;
 
//------------------------------------------------------------------------------
procedure TSLTInterfacedObject.SetController(const Value: IInterface);
begin
  // weak reference to controller - don't keep it alive
  // L'utilisation du Pointer non typé permet de conserver le lien avec le contrôleur sans perturber le compteur de référence
  // Cela évite une dépendance mutuelle entre le contrôleur et son objet interne agrégé
  FController := Pointer(Value);
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject._AddRef(): Integer;
begin
  if Assigned(FController) then
    Result := IInterface(FController)._AddRef()
  else
    Result := InheritedAddRef();
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedObject._Release(): Integer;
begin
  if Assigned(FController) then
    Result := IInterface(FController)._Release()
  else
    Result := InheritedRelease();
end;
 
{ TSLTInterfacedReferencableObject }
 
//------------------------------------------------------------------------------
procedure TSLTInterfacedReferencableObject.AfterConstruction();
begin
  inherited AfterConstruction();
  FIsAfterConstruction := True;
end;
 
//------------------------------------------------------------------------------
procedure TSLTInterfacedReferencableObject.BeforeDestruction();
begin
  // Si l'on tente de détruire l'objet, il ne doit rester QU'UNE SEULE la référence sur l'interface
  // Sauf si l'on est en mode sans compteur de référence prévu pour une utilisation via une instance d'objet !
  if not FNoReferenceCouting then
  begin
    try
      inherited BeforeDestruction();
    except
      on E: Exception do
        raise ExceptClass(E.ClassType).CreateFmt('%s : %s', [Self.ClassName(), E.Message]);
    end;
  end;
end;
 
//------------------------------------------------------------------------------
procedure TSLTInterfacedReferencableObject.SetNoReferenceCouting(const Value: Boolean);
begin
  if FNoReferenceCouting <> Value then
  begin
    FNoReferenceCouting := Value;
    if ((FRefCount > 0) and FIsAfterConstruction) or ((FRefCount > 1) and not FIsAfterConstruction)  then
      raise ESLTInterfacedReferencableObjectError.Create(ERR_CANT_DISABLE_COUTING_REFERENCE);
  end;
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedReferencableObject._AddRef(): Integer;
begin
  if FNoReferenceCouting then
    Result := -1 // -1 indicates no reference counting is taking place, see TComponent IInterface implementation
  else
    Result := inherited _AddRef();
end;
 
//------------------------------------------------------------------------------
function TSLTInterfacedReferencableObject._Release(): Integer;
begin
  if FNoReferenceCouting then
    Result := -1 // -1 indicates no reference counting is taking place, see TComponent IInterface implementation
  else
    Result := inherited _Release();
end;
 
{ TSLTInterfacedObjectFactory }
 
//------------------------------------------------------------------------------
class procedure TSLTInterfacedObjectFactory.IntfFactory(const AClass: TClass; const IID: TGUID; out Intf; const AController: IInterface = nil);
var
  Impl: TObject;
begin
  // Attention, cette factory n'est pas thread safe
  // Veillez à ce que les méthodes appelantes gère l'instance (et AClass) avec un verrou si cela s'avère nécessaire
  if AClass.InheritsFrom(TSLTInterfacedObject) then
    Impl := TSLTInterfacedObjectClass(AClass).Create(AController)
 
  else if AClass.InheritsFrom(TAggregatedObject) then
    Impl := TAggregatedObjectClass(AClass).Create(AController)
 
  else if AClass.InheritsFrom(TSLTInterfacedObject) then
    Impl := TSLTInterfacedObject(AClass).Create()
 
  else
    Impl := AClass.Create();
 
 
  try
    // La classe AClass par défaut utilisée comme Implémentation pour cet IID doit évidemment fourni son support !
    // L'utilisation d'une TClass est très ouverte mais nécessite que l'on cast l'instance vers son interface
    if not Supports(Impl, IID, Intf) then
      raise ESTLIntfCastError.Create(Impl, IID); // Pseudo-Assert Exception !
  except
    // Pour toute exception qu'elle soit prévue comme EIntfCastError ou imprévue (on ne sait jamais)
    // il faut libérer l'objet que l'on vient d'instancier mais que ne sera jamais utilisé
    on E: Exception do
    begin
      Impl.Free();
      raise;
    end;
  end;
end;
 
 
 
end.

Hier, je n'ai pas eu le temps mais tes deux interfaces interner de TBZCustomMachine
Faudrait vérifier que par un jeu de dépendance, l'une et l'autre ne se maintiennent pas en vie mutuellement

[BeanzMaster]

Bonjour à tous

@Anapurna : Merci pour la référence de Nick Hodges, ses articles sont intéressants mais ne m'ont pas donné de réponse.

Hier, je n'ai pas eu le temps mais tes deux interfaces interner de TBZCustomMachine
Faudrait vérifier que par un jeu de dépendance, l'une et l'autre ne se maintiennent pas en vie mutuellement

Je crois que c'est ça le problème. il y semble y avoir interference entre TBZCustomMachine qui est un objet observable et l'objet observable qui est à l'intérieur. Pour cause

Test 1 :

J'ai débuté ce matin sur tes conseils en utilisant la fonction SUPPORTS. Résultat toujours FAUX. Comme un bourrin, quand je suis confronté à ce genre cas je met des "showmessage" a tout va pour vérifier la progression des objets et des valeurs.

Résultat :

Entre le FormCreate, le FormShow, le FormActivate tout est ok, la fiche apparait "no problems" . Mais dès que je modifie une valeur, je rentre dans l'événement OnChange et paf surprise ! Mon objet observable dans TBZMachine N'EST PLUS ASSIGNE !!!! ou est-il passé ?


Test 2 :

Je modifie mes classe de base TBZCustomObservableObject, TBZCustomObserverObject, TBZCustomMachine en surchargant Addref, Realase, QueryInterface comme je l'ai mentionné hier et
Cet fois-ci mon objet observable dans TBZMachine est bien assigné, mais

Résultat :

une exception complément délirante est levée a cet endroit :



Que vient faire la classe TIcon là dedans ?????

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
procedure TBZCustomMachine.DoComboboxChange(Sender: TObject);
begin
  Showmessage('DoComboboxChange');
  if not(Assigned(ObservableValues)) then showmessage('ERROR FObservableValues NOT ASSIGNED');
 
  if Supports(ObservableValues, IBZObservableValues) then
  begin
    Showmessage('Ok');
 
    -------------> EXCEPTION LEVEE ICI ???????? <-------------
 
    ObservableValues.Operation := TMathOperations(TComboBox(Sender).ItemIndex);  -----> JE NE RENTRE MEME PAS DANS le Setteur
    //---> Idem en direct avec FObservableValues.Operation :=
    Showmessage('Change Done');
  end;
end;

[EDIT] : L'exception est en fait levé à la sortie de

Code :

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

1
2
3
4
5
6
7
function TCustomCombo.GetItemIndex: Integer;
begin
  if csLoading in ComponentState then
    Result := FItemIndex
  else
    Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
end;

[/EDIT]

Merci Shail, je vais étudié ton unité. petite question

Faudrait vérifier que par un jeu de dépendance, l'une et l'autre ne se maintiennent pas en vie mutuellement

Comment on fait ça ? je suis perdu sur ce coup, je ne visualise pas comment faire

Merci

[ShaiLeTroll]

C'est assez chiant à déboguer

Code :

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

if Supports(ObservableValues, IBZObservableValues) then

ObservableValues est de quel type ?
Vu ton code c'est soit déjà un IBZObservableValues dont as/supports inutile ou un TBZMachineObservableValues que l'on devine comme implémentant IBZObservableValues

Code :

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

1
2
3
4
    function GetObservableValues: TBZMachineObservableValues;
    function GetObserverValues: TBZMachineObserverValues;
    procedure SetObservableValues(AValue: TBZMachineObservableValues);
    procedure SetObserverValues(AValue: TBZMachineObserverValues);

je changerais tout ça par des interfaces IBZObservable et IBZObserver
Ne force pas le type, tout l'intérêt des interfaces c'est juste un coupable faible du code
Là en utilisant des objets, je pense que tu crées de weak référence, du coup des implémentations sont libérées prématurément

Ne te sers jamais de "Intf as Class" !
Cela casse toute la cohérence de l'utilisation d'interface dans GetObservableValues
C'est une nouveauté mais c'est à proscrire, c'est pour des cas extrême
Toujours "Obj as Intf" ou "Intf1 as Intf2"


FObservableValues1, FObservableValues2, FObservableValues3 sont des IBZObservableValues ou TBZObservableValues ?
Idem, faut que cela soit plutôt des IBZObservableValues

As-tu aussi des Free ? une affectation à un nil d'une variable de type interface suffit pour libérer (via compteur)

[BeanzMaster]

C'est assez chiant à déboguer

Tu m'étonnes !

je changerais tout ça par des interfaces IBZObservable et IBZObserver
Ne force pas le type, tout l'intérêt des interfaces c'est juste un coupable faible du code
Là en utilisant des objets, je pense que tu crées de weak référence, du coup des implémentations sont libérées prématurément

C'est bien ce que j'avais au début. Je suis donc revenue à cette formule.
Comme c'était à la base (dans le zip) et en revenant à la déclaration IBZObservable au lieu de ma classe. Cela ne fonctionnait toujours pas.
En surchargeant _AddRef, _Realase et QueryInterface dans l'ancêtre (TBZCustomObservable) Tout fonctionne nickel Maintenant il faut que teste les fuites de mémoire si il y'en a (et je pense que oui).

FObservableValues1, FObservableValues2, FObservableValues3 sont des IBZObservableValues ou TBZObservableValues ?
Idem, faut que cela soit plutôt des IBZObservableValues

En fait il faut que je passe par l'interface de base "IBZObservable" (Héritage oblige) pour rendre tout ce petit monde compatible.

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
  IBZObservable = interface [IBZOBSERVABLE_GUID]
    procedure AddObserver(Obs: IBZObserver);     // Attache un nouvel observateur
    procedure RemoveObserver(Obs: IBZObserver);  // Supprime un observateur
    procedure NotifyObservers;                   // Notifie tous les observateurs
  end;
 
  { IBZObserver : Interface Observateur }
  IBZObserver = interface [IBZOBSERVER_GUID]
    procedure ExecuteObserver(Observable: IBZObservable);    // Execute une tâche
    procedure AttachToObservable(Observable: IBZObservable); // Attache l'observateur à un sujet
  end;
 
  TBZObserverExecuteEvent = procedure (sender: TObject; anObservable: IBZObservable) of object;
  TBZCustomObserverObject = class(TInterfacedObject, IBZObserver)
    private
      FOwner : TObject;
      FOnExecute : TBZObserverExecuteEvent; // On peut s'en servir dynamiquement
    protected
      FObservableRef : TInterfaceList; //IBZObservable;       // sert de référence
      FObservableRefCount : Integer;
 
      { ExecuteObserver : Hérité de l'interface IBZObserver }
      procedure ExecuteObserver(Observable: IBZObservable); virtual;
    public
      { Création de l'objet observateur }
      Constructor Create(AOwner : TObject);
      { Destruction de l'objet observateur }
      Destructor Destroy; override;
      { Attache l'observateur à un objet observable }
      procedure AttachToObservable(Observable: IBZObservable); virtual;
      function GetObservableRefCount : Integer;
 
      { OnExecute : Evénement appelé à chaque notification faite par un objet observable avec lequel l'observateur est lié. }
      property OnExecute : TBZObserverExecuteEvent read FOnExecute write FOnExecute;
      { Propriétaire de l'objet }
      property Owner : TObject read FOwner write FOwner;
  end;
 
  TBZCustomObservableObject = class(TInterfacedObject, IBZObservable)
    private
      FObservers: TInterfaceList;     // Liste des observateurs
      FObservableRef: IBZObservable;  // sert de référence est ce utile ici ?????
      FOwner : TObject;
      FTag : Integer;                 // Propriété fourre-tout : Tag, TagPointer, TagObjet, TagFloat... Tag tag tag....
    protected
       // Sans cette surcharge ça plante sévère
       function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
       function _AddRef: Integer; stdcall;
       function _Release: Integer; stdcall;
    public
      { Création de l'objet observable }
      constructor Create(Observable: IBZObservable); overload;
      constructor Create(AOwner : TObject; Observable: IBZObservable); overload;
      { Destruction de l'objet observable }
      destructor destroy; override;
      { AddObserver : Attache un nouvel observateur }
      procedure AddObserver(Obs: IBZObserver);
      { RemoveObserver : Supprime un observateur }
      procedure RemoveObserver(Obs: IBZObserver);
      { NotifyObservers : Notifie tous les observateurs }
      procedure NotifyObservers;
      { Tag : Propriété fourre-tout }
      property Tag : Integer read FTag write FTag;
      { Propriétaire de l'objet }
      property Owner : TObject read FOwner write FOwner;
  end;
 
 IBZObservableValues = interface
    ['{ED1B731B-39FE-4B92-A35E-62305ED365BD}']
    procedure SetValue1(AValue : Integer);
    procedure SetValue2(AValue : Integer);
    procedure SetOperation(AValue : TMathOperations);
  end;
 
  IBZObservableMachineResult = interface
    ['{B04654A9-798F-40E1-BE72-FCC4938978AB}']
    procedure SetOpResult(AValue: Integer);
  end;
 
  TBZAbstractObservableValues = class (TBZCustomObservableObject, IBZObservableValues)
  private
    FValue1 : Integer;
    FValue2 : Integer;
    FOperation : TMathOperations;
 
    procedure DoSetValue1(AValue : Integer); virtual; abstract;
    procedure DoSetValue2(AValue : Integer); virtual; abstract;
    procedure DoSetOperation(AValue : TMathOperations); virtual; abstract;
 
    procedure SetValue1(AValue : Integer);
    procedure SetValue2(AValue : Integer);
    procedure SetOperation(AValue : TMathOperations);
   ...
  end;
 
  TBZMachineObservableValues = class(TBZAbstractObservableValues)
  private
    procedure DoSetValue1(AValue : Integer); override;
    procedure DoSetValue2(AValue : Integer); override;
    procedure DoSetOperation(AValue : TMathOperations); override;
  end;
 
  TBZMachineObserverValues =  Class(TBZCustomObserverObject)
  protected
     procedure ExecuteObserver(Observable: IBZObservable); override;
  end;
 
  TBZCustomMachine = class(TBZCustomObservableObject, IBZObservable, IBZObservableMachineResult) // Obligation de réintroduire IBZObservable
  private
    FObservableValues : IBZObservable;  // TBZMachineObservableValues;
    FObserverValues    : IBZObserver;     // TBZMachineObserverValues;
  ...
  end;
 
  TForm1 = class(TForm, IBZObserver)
    ...
  private
    { Déclarations privées }
    FMachineA, FMachineB : IBZObservable; // TBZMachine;
    FResultatMachine1,  FResultatMachine2 : Integer;
  ...
  end;

Ne te sers jamais de "Intf as Class" !
Cela casse toute la cohérence de l'utilisation d'interface dans GetObservableValues
C'est une nouveauté mais c'est à proscrire, c'est pour des cas extrême
Toujours "Obj as Intf" ou "Intf1 as Intf2"

Oui c'est ce que j'ai lu. Mais ce que je ne fait pas.

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
procedure TBZMachineObserverValues.ExecuteObserver(Observable: IBZObservable);
Var
  LObservableObject : TBZMachineObservableValues;
  LVal1, LVal2, OpResult : Integer;
begin
  LObservableObject := (Observable As  TBZMachineObservableValues);
  LVal1 := LObservableObject.Value1;
  LVal2 := LObservableObject.Value2;
...
 
// 2 manières d'utiliser Supports
procedure TBZCustomMachine.DoEditingDoneEdit2(Sender: TObject);
begin
  if Supports(FObservableValues, IIBZOBSERVABLE_GUID) then
    (FObservableValues As TBZMachineObservableValues).Value2 := StrToInt(TEdit(Sender).Text);
end;
 
procedure TBZCustomMachine.DoComboboxChange(Sender: TObject);
begin
  if Supports(ObservableValues, IBZObservableValues) then
  begin
    (FObservableValues As TBZMachineObservableValues).Operation := TMathOperations(TComboBox(Sender).ItemIndex);
  end;
end;
 
procedure TForm1.ExecuteObserver(Observable: IBZObservable);
Var
  LObservableObject : TBZMachine;
  OpResult : Integer;
  LOp : TMathOperations;
  LOpStr : String;
begin
  LObservableObject := Observable As TBZMachine;
  Case LObservableObject.Tag of
    1 :
    begin
      FResultatMachine1 := LObservableObject.OpResult;
      lblResultat1.Caption := IntToStr(FResultatMachine1 );
    end;
    2 :
    begin
      FResultatMachine2 := LObservableObject.OpResult;
      lblResultat2.Caption := IntToStr(FResultatMachine2);
    end;
  end;
....

Donc petite question sur ce point. Dans ce cas par quoi ou comment je remplace ce AS ? est ce que je dois garder une référence de classe dans TBZCustomMachine et TBZMachineObserverValues ?

Genre :

Code :

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

1
2
3
4
5
6
7
procedure TBZCustomMachine.DoComboboxChange(Sender: TObject);
begin
  if Supports(ObservableValues, IBZObservableValues) then
  begin
    FObservableValuesRefClass.Operation := TMathOperations(TComboBox(Sender).ItemIndex); // On utilise la référence ???
  end;
end;

Mais dans ce cas dans TForm1 est-ce nécessaire de déclarer aussi

Code :

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

1
2
 FMachineA, FMachineB : IBZObservable; 
           FMachineARef, FMachineBRef : TBZMachine;

Du coup si je fais comme ça dans procedure TForm1.ExecuteObserver(Observable: IBZObservable); comment savoir quelle machine a été mise à jour ?

Merci Shai de ton aide, tu m'as permis d'y voir plus clair déjà

Une fois tout coder correctement et comme il se doit je mettrais au propre et attacherai un petit zip

[ShaiLeTroll]

Donc petite question sur ce point. Dans ce cas par quoi ou comment je remplace ce AS ? est ce que je dois garder une référence de classe dans TBZCustomMachine et TBZMachineObserverValues ?

Regarde Supports avec trois paramètres mais cela revient à faire un as, c'est juste que cela évite les exceptions si l'interface n'est pas supporté

Je ne suis pas assez impliqué dans ton code pour savoir comment m'y prendre, c'est toujours plus difficile de reprendre le code d'un autre.
Banni toute utilisation de classe d'implémentation dans ton code, aucune variable, aucun retour
Juste l'instanciation via Create c'est le seul moment où cela doit être utilisé, partout ailleurs faut utiliser l'interface la plus simple,
si l'on connait son type, tu peux utiliser IBZObservable ...
si tu ne connais pas le type à l'avance ou qu'il peut être multiple, je préfère une variable IInterface et Supports

Par force des choses que tu comprendras mieux comme on utilise IInterface ou tes interfaces personnelles en dégageant partout les TBZ***

Mais dans ce cas dans TForm1 est-ce nécessaire de déclarer aussi

Cela dépend du point de démarrage, une instance n'est utile que si tu veux l'utiliser,
Il faut fort possible qu'à partir d'une seule tu peux retrouver tous les autres par jeu des propriétés (dépendance 1-1 ou 1-N)

[ALWEBER]

Bonjour,
Ce qu'il faut retenir des interfaces c'est l'obligation d'implémenter les descriptions décrites dans les interfaces. Si tu es en pur pascal objet cela n'a pas grand sens puisque tu as normalement la visibilité de toutes les classes de ton projet. Cela par contre a un sens soit en c++ soit en java ou les paradigmes de programmation sont différents et ce qui est quand même le cas pour des cibles comme Androïd. Il y a eu une belle présentation en Hollande organiée par Barnsten l'année dernière sur ce sujet. je vais la retrouver et la rendre accessible. J'ai retrouvé aussi la présentation qui en est faite dans le manuel de programmation objet de Delphi 5 et est fort interessante. l'Interface était essentiellement utilisée à l'époque avec les process COM/DCOM de Microsoft.
A titre d'exemple j'ai reproduit ce qui est proposé dans l'aide Delphi sur le pattern observer ce qui est a mon sens sans intérêt puisque on peut faire la même chose avec des évènements.(Idem avec le singleton qui peut être remplacé par une utilisation judicieuse des "Class FUnction" et autres. Mais si quelqu'un veut enrichir la discussion je suis preneur et je ne détiens pas la Vérite avec un grand V

ci après les liens sur les documents dont j'ai parlé :
Document 1
Document 2

[BeanzMaster]

Bonjour

Merci pour les documents ALWEBER

Par force des choses que tu comprendras mieux comme on utilise IInterface ou tes interfaces personnelles en dégageant partout les TBZ***

Bon j'ai eu un peu de temps ce week-end entre deux pour regarder

Merci Shai, j'ai viré toutes les références aux classe, pour ne garder que les interfaces. Et c'est nickel, tout fonctionne.
Ce qui m'a mis dedans, ce sont les exemples que j'avais trouvé sur le Web. L'utilisation du intf As class qui en est faite fonctionne, car dans ces exemples ils sont appelés qu'une seule fois. De plus dans ces exemples le niveau d'imbrication était un poil plus faible par rapport à mon test pourtant très "neuneu".

Bref j'ai quand même du mal à saisir pourquoi ils ont instauré ce intf As Class. C'est totalement malicieux et c'est hasardeux de l'utiliser. Il faut vraiment savoir ce que l'on fait avec. Une banane peut devenir un kiwi vite fait bien fait. De plus son utilisation décrémente automatique le compteur de référence ce qui génère des erreurs. Sauf si il est utilisé en fin de traitement et que l'on ne doit plus faire appel à l'interface. A moins de la réinitialisée.

Pour ce qui est du support avec 3 paramètres je ne suis pas fan non plus du coup. L'utilisation de Support et de intf as intf est bien plus efficace et sécurisé. L'utilisation des interfaces devient plus logique et colle beaucoup mieux à leur description. Et maintenant même plus besoins de surcharger addref, release et queryinterface

Merci encore pour ton aide Shai, cela m'a permis de mieux comprendre le mécanisme des interfaces.

Pour ceux que cela intéresse je joint mon petit projet de Test

Design pattern.zip

A bientôt

[ALWEBER]

Bonjour, j'ai repris le fichier zip que tu as proposé. Ton travail est de très bonne qualité
J'ai fait une seconde application iso-fonctionnelle sans pattern juste pour ouvrir le débat
D5A.zip

[popo]

Bonjour,
Ce qu'il faut retenir des interfaces c'est l'obligation d'implémenter les descriptions décrites dans les interfaces. Si tu es en pur pascal objet cela n'a pas grand sens puisque tu as normalement la visibilité de toutes les classes de ton projet. Cela par contre a un sens soit en c++ soit en java ou les paradigmes de programmation sont différents et ce qui est quand même le cas pour des cibles comme Androïd. Il y a eu une belle présentation en Hollande organiée par Barnsten l'année dernière sur ce sujet. je vais la retrouver et la rendre accessible. J'ai retrouvé aussi la présentation qui en est faite dans le manuel de programmation objet de Delphi 5 et est fort interessante. l'Interface était essentiellement utilisée à l'époque avec les process COM/DCOM de Microsoft.
A titre d'exemple j'ai reproduit ce qui est proposé dans l'aide Delphi sur le pattern observer ce qui est a mon sens sans intérêt puisque on peut faire la même chose avec des évènements.(Idem avec le singleton qui peut être remplacé par une utilisation judicieuse des "Class FUnction" et autres. Mais si quelqu'un veut enrichir la discussion je suis preneur et je ne détiens pas la Vérite avec un grand V

Je vais apporter un avis légèrement différent car les interface ont un grand intérêt y compris en Delphi.

L’objectif premier d’une interface est de définir la frontière de communication entre deux entités. Concrètement, lorsqu'un programme appelle une DLL, tout ce qu’il voit c’est le contrat.
Elle joue également un rôle essentiel dans l'utilisation des modèles d'objets distribués (comme SOAP).

Le deuxième objectif consiste à diminuer le couplage , car une interface est quelque chose d’abstrait.
Plus le couplage est faible et plus le système est souple, et c'est à mon avis la principale utilité de l'interface

[BeanzMaster]

Bonsoir, mon exemple est bateau, et il est clair le patron observer n'est pas utile dans ce cas

Mais, imagines que dans une application, dans la fenêtre principale tu récupères une vingtaines de données boursières. Les données en cours sont affichées. Maintenant dans une deuxième fenêtre tu as un graphique mis à jour en temps réel avec juste les 5 valeurs qui t'intéresses. Et dans dans une troisième un listing de toutes les valeurs , puis une quatrième qui calcul les moyennes par exemples, etc...etc.... Le patron observer est alors bien utile pour mettre tout ce petit monde a jour. Il suffit juste d'attacher l'observateur aux données quand tu ouvre une ou toute les fenêtres. Cette façon de faire est alors très pratique et tu peux rajouté autant de fenêtre que tu veux et cela sans modifier d'un caractère la fiche principale.

[foetus]

une weak reference c'est soit une gestion sans compteur soit le stockage de la référence dans un pointeur pour que le compteur ne soit pas modifier

Bof l'explication est un peu vaseuse

Un objet A possède des ressources (données, handles, pointeurs, ...) et donc il gère leur durée de vie et éventuellement leur création et leur destruction (composition vs agrégation)

Et le problème vient lorsqu'un autre objet B veut utiliser une ressource A

• Est-ce que cet objet B va l'utiliser assez longuement (strong reference) ou de façon brève (weak reference) ?
• Est-ce que cet objet B va juste la lire (weak reference) ou la modifier (strong reference) ? (<- à vérifier)

En gros avec une weak references c'est pour l'utiliser tout de suite et garder une telle référence peut-être dangereux (les ressources ne sont plus accessibles)
Et par conséquent pas la peine d'"en tenir compte" (ramasse miettes, compteur de références, ...)

Après, le problème est plus étendu parce qu'il y a soft reference, phantom et en C++ moderne shared_ptr (une strong reference qui garde une liste des weak references si je ne me trompe pas)

[ALWEBER]

Bonsoir, mon exemple est bateau, et il est clair le patron observer n'est pas utile dans ce cas
Mais, imagines que dans une application, dans la fenêtre principale tu récupères une vingtaines de données boursières. Les données en cours sont affichées. Maintenant dans une deuxième fenêtre tu as un graphique mis à jour en temps réel avec juste les 5 valeurs qui t'intéresses. Et dans dans une troisième un listing de toutes les valeurs , puis une quatrième qui calcul les moyennes par exemples, etc...etc.... Le patron observer est alors bien utile pour mettre tout ce petit monde a jour. Il suffit juste d'attacher l'observateur aux données quand tu ouvre une ou toute les fenêtres. Cette façon de faire est alors très pratique et tu peux rajouté autant de fenêtre que tu veux et cela sans modifier d'un caractère la fiche principale.

Ce que tu dit est vrai dans le cas d'une IHM (Interface Homme Machine) statique de le cas du paradigme de la POO. Or à base de Delphi il y a la VCL (voir l: draft initial)
Le modèle objet de la POO implique que les objets communiquent entre eux avec des messages. Or dans le cas de Delphi avec la VCL le principal objet qui communique avec les autres c'est MS-WIndows. Donc, l'exemple que tu présente est facilement reproductible sans Pattern. Par contre dans le cas d'une interface avec un composant externe (SOAP, DLL,...) interfaces et pattern s'avèrent fort utiles.