Salut à tous !
Qui ne s'est jamais dit qu'il serait pratique de pouvoir ajouter de nouveaux champs à un assistant de classe ? Je vous propose aujourd’hui une petite unité permettant de faire cela de façon totalement transparente.
Sur le principe il ne s'agit que de lier une allocation avec notre objet. Cette liaison est faite à l'aide d'un TDictionary<TObject, pointer> où la clé est l'instance de notre objet et la valeur une instance d'une classe contenant nos champs. La valeur est définie en pointeur non typé puisque ce type est compatible avec tout type de pointeur, ce qui nous évite des transtypages par la suite.
L'assistant de classe doit obligatoirement contenir une méthode permettant de récupérer cette liaison. C'est la seule prérogative, à part la déclaration des champs bien sûr.
Voici la structure et l'implémentation de base d'un assistant "étendu" :
Certains se demanderont peut-être pourquoi passer par une classe TFields et non un simple enregistrement. Les raisons sont multiples :
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 type TObjectHelper = class helper for TObject private type TFields = class(THelperFields) // Les nouveaux champs end; private function Fields :TFields; end; implementation function TObjectHelper.Fields: TFields; begin Result := THelperFieldsObject.Get(Self, TFields); end;
- avoir un constructeur (voire un destructeur) pour l'initialisation des champs peut être pratique. Accessoirement c'est pour cela que TFields dérive de THelperFields et non de TObject : avoir un constructeur surchargeable ;
- le polymorphisme fait que le type réel n'a pas besoin d'être connu. Avec un enregistrement nous ne pourrions que passer sa taille et récupérer un pointeur après GetMem ;
- mais la principale est la gestion des types managés. Sur un enregistrement et après FreeMem, nous nous retrouverions avec des fuites mémoires.
Voici un exemple plus complet après l'ajout d'une propriété Champ1 :
Comme vous le voyez, rien de compliqué
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 type TObjectHelper = class helper for TObject private type TFields = class(THelperFields) Champ1 :integer; end; private function Fields :TFields; function GetChamp1: integer; procedure SetChamp1(const Value: integer); public property Champ1 :integer read GetChamp1 write SetChamp1; end; implementation function TObjectHelper.Fields: TFields; begin Result := THelperFieldsObject.Get(Self, TFields); end; function TObjectHelper.GetChamp1: integer; begin Result := Fields.Champ1; end; procedure TObjectHelper.SetChamp1(const Value: integer); begin Fields.Champ1 := Value; end;
Qu'est-ce que tout cela implique dans notre code ? La réponse est simple : rien ! l'unité proposée se chargeant de tout vous n'aurez toujours qu'un TObject.Create/Object.Free.
La fonction THelperFieldsObject.Get se charge de créer le manager ainsi que notre objet "Champs" et maintenir la liaison dans un TDictionary.
Mais comment sont libérés ses champs sur Free ? me direz-vous. Et bien certains d'entre-vous le savent peut-être ; il est possible depuis XE de surcharger une méthode virtuelle... en runtime, une forme d'héritage dynamique. Cette mise en route se fait à l'aide d'un TVirtualMethodInterceptor. Dès lors nous n'avons plus qu'à insérer une méthode de libération dans cette chaîne polymorphe et le tour est joué ! La méthode qui nous intéresse à surcharger est évidemment FreeInstance.
Voici la fonction Get :
Et la fonction de libération VMIOnBefore :
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 class function THelperFieldsObject.Get(aInstance: TObject; aFieldsClass: THelperFieldsClass): pointer; var VMI :TVMI; begin TMonitor.Enter(FLock); try // Création du manager ou récupération des champs s'ils existent if not Assigned(FHelperFields) then FHelperFields := THelperFieldsObject.Create else if FHelperFields.ObjectList.TryGetValue(aInstance, Result) then Exit; // Création des champs et ajout au dictionnaire Result := aFieldsClass.Create; FHelperFields.ObjectList.Add(aInstance, Result); // Création de l'intercepteur s'il n'existe pas encore pour ce type if not FHelperFields.VMIList.TryGetValue(aInstance.ClassType, VMI) then begin VMI.RefCount := 1; VMI.Interceptor := TVirtualMethodInterceptor.Create(aInstance.ClassType); VMI.Interceptor.OnBefore := VMIOnBefore; end else inc(VMI.RefCount); // Liaison entre l'objet et l'intercepteur VMI.Interceptor.Proxify(aInstance); // Ajout de l'intercepteur au dictionnaire ou mise à jour du RefCount FHelperFields.VMIList.AddOrSetValue(aInstance.ClassType, VMI); finally TMonitor.Exit(FLock); end; end;
A noter encore qu'il n'y a aucun overhead systématique, notre objet "Champs" n'est créé que lors du premier accès à un champ et l'intercepteur n'est appliqué à cet objet qu'à ce moment-là.
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 class procedure THelperFieldsObject.VMIOnBefore(aInstance: TObject; aMethod: TRttiMethod; const aArgs: TArray<TValue>; out aDoInvoke: Boolean; out aResult: TValue); var VMI :TVMI; PFields :pointer; begin // Seule FreeInstance nous intéresse if not SameText(aMethod.Name, 'FreeInstance') then Exit; TMonitor.Enter(FLock); try if FHelperFields.VMIList.TryGetValue(aInstance.ClassType, VMI) then begin // Suppression de la liaison VMI.Interceptor.Unproxify(aInstance); dec(VMI.RefCount); // Libération de l'intercepteur si plus utilisé. Asynchrone puisque nous sommes dans une méthode de cet objet if VMI.RefCount = 0 then begin FHelperFields.VMIList.Remove(aInstance.ClassType); AsynFree(VMI.Interceptor); end else FHelperFields.VMIList.AddOrSetValue(aInstance.ClassType, VMI); end; // Libération des champs if FHelperFields.ObjectList.TryGetValue(aInstance, PFields) then begin FHelperFields.ObjectList.Remove(aInstance); TObject(PFields).Free; end; // Libération du manager si plus utilisé if FHelperFields.ObjectList.Count = 0 then FreeAndNil(FHelperFields); finally TMonitor.Exit(FLock); end; end;
Dernière remarque : le principe évoqué ici n'est applicable qu'aux assistants de classe, pas aux assistants d'enregistrement dépourvu de notion d'héritage, donc de méthode virtuelle.
Voilà ! et comme d'hab', amusez-vous bien
EDIT:
Version 2:
Correction sur la VMIList. Utilise le ClassName plutôt que le ClassType. Elle est également transformée en interface pour se passer de cette destruction asynchrone.
Gère maintenant les assistants multiples : le cas d'un assistant sur une classe ancêtre en plus de la classe courante.
EDIT:
Version finale:
Pas convaincu par l'interface, l'objet est de toute façon libéré trop tôt. Supprimé !
Simplification de l'accès aux champs par une méthode de classe de THelperFields, la méthode Fields devient Result := TFields.Get(Self).
Delphi Add field/property to class helpers
Partager