Discussion :

[Nono40]

Bonjour,

J'ai besoin dans une application de créer un type de classe par son nom (paramètre dans une base).

J'utilise d'habitude RegisterClass et GetClass mais ceux-ci ne fonctionnent qu'avec des TPersistentClass au minimum. Or les classes en question sont des TObjectList.
Le registerClass est dans la secion Initialization de l'unité. J'ai N unité avec différents fonctionnements et la bonne est utilisée avec le GetClass.

Il me semblait qu'il y avait une solution fonctionnant depuis le TObject.

Sinon il faudra que je crée descendant de TPersistentClass contenanant un TObjectList et que je reporte les méthodes vituelles mises sur le TObjectList vers le TPersistantClass. Ca va allourdir le code pour pas grand chose.

Merci par avance.

[Paul TOTH]

Bonjour,

J'ai besoin dans une application de créer un type de classe par son nom (paramètre dans une base).

J'utilise d'habitude RegisterClass et GetClass mais ceux-ci ne fonctionnent qu'avec des TPersistentClass au minimum. Or les classes en question sont des TObjectList.
Le registerClass est dans la secion Initialization de l'unité. J'ai N unité avec différents fonctionnements et la bonne est utilisée avec le GetClass.

Il me semblait qu'il y avait une solution fonctionnant depuis le TObject.

Sinon il faudra que je crée descendant de TPersistentClass contenanant un TObjectList et que je reporte les méthodes vituelles mises sur le TObjectList vers le TPersistantClass. Ca va allourdir le code pour pas grand chose.

Merci par avance.

et pourquoi n'utilises-tu pas simplement un StringList (ou une Liste si tu fais la recherche toi-même) que tu alimenterais avec les classes dont tu as besoin ?

Code :

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

1
2
 
  MyList.AddObject(MaClasse.ClassName, MaClasse);

[Nono40]

Ca c'est une super idée.


Pour ceux que ça intéressent, voici le code complet :
Dans une unité commune il faut mettre :

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
 
interface
 
Var
  // Gestion de la liste des classes
  ListeClasses     : TStringList = Nil;
 
Procedure AjouterClasse(Classe:TClass);
Function TrouverClasse(Const NomClasse:String):TClass;
 
implementation
 
Procedure AjouterClasse(Classe:TClass);
Begin
  // La liste est créée à la volée sur le premier appel
  // comme cela on ne dépend pas de l'ordre de création des unités
  if ListeClasses=Nil then
    ListeClasses:=TStringList.Create;
 
  if ListeClasses.IndexOf(Classe.ClassName)<0 then
    ListeClasses.AddObject(Classe.ClassName,TObject(Classe));
End;
 
Function TrouverClasse(Const NomClasse:String):TClass;
Var
  Idx : Integer;
Begin
  Result := Nil;
  Idx := ListeClasses.IndexOf(NomClasse);
  if Idx>=0 then
    Result := TClasseListe(ListeClasses.Objects[Idx]);
End;
 
Initialization
Finalization
  ListeClasses.Free;
end.

Pour enregistrer les classes (n'importe ou dans le code comme dans la section initialization des unités)

Code :

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

1
2
 
  AjouterClasse(TListePerso);

Pour chercher la classe et la créer :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Var
  Classe : TClass;
begin
  Classe := TrouverClasse(ERPClasseBordereau);
  if Classe<>Nil then
  Begin
    // Ici il faut surcharger le type avec la classe minimum souhaitée
    ListeBordereau := TListeBordereau(Classe.Create);
    Splash.FaitMessage('Liste bordereaux ='+ListeBordereau.ClassName+'...');
  End;
end;

La recherche est case-sensitive, il faut stocker/tester avec des UpperCase pour la rendre insensible à la casse.

[Edit]TCLasseListe supprimé et remplacé par TClass suite à la remarque de Shai

[ShaiLeTroll]

Une Class Registry est un grand classique !
Typique de la coupler avec une Factory !

Tu pourrais trier ta liste Sorted\Duplicates\dupIgnore, cela améliorait le IndexOf !
L'Ajout sera plus long, mais comme il n'est fait qu'une seule fois, le gain se compense très vite !

Tout de même, c'est vilain comme nommage, TClasseListe n'est pas une liste !
il existe le TClass
Ou alors tu prévois ceci : TClasseListe = Class Of TNono40AbstractList; ?
Et le nommage est pertinent !

un code plus POO avec une TClasseListeManager, avec comme méthode de classe RegisterClass\FindClass ainsi que CreateInstance (cela généralise le code d'instanciation)

Si tu as un Delphi récent (2009+), c'est l'occasion d'utiliser le System.Generics.Collections.TDictionary

[Nono40]

Tu pourrais trier ta liste Sorted\Duplicates\dupIgnore, cela améliorait le IndexOf !
L'Ajout sera plus long, mais comme il n'est fait qu'une seule fois, le gain se compense très vite !

Dans mon cas ce n'est pas un soucis, il n'y aura que quelques classes et que très peu de recherche une seule fois au lancement de l'application.

Tout de même, c'est vilain comme nommage, TClasseListe n'est pas une liste !
il existe le TClass
Ou alors tu prévois ceci : TClasseListe = Class Of TNono40AbstractList; ?
Et le nommage est pertinent !

Tu as parfaitement raison. ce n'était pas un TObject à la base j'ai changé le type ensuite et je n'ai pas renommé la classe. J'ai mis à jour mon message avec TClass.

Si tu as un Delphi récent (2009+), c'est l'occasion d'utiliser le System.Generics.Collections.TDictionary

Je vais jeter un oeil

[Nono40]

Je remonte le sujet pour compléter la solution trouvée.

Tout fonctionne bien tant que l'on a pas besoin de surcharger le constructeur dans les classes enfants. Le constructeur Create du TObject n'est malheureusement pas virtuel.

Pour gérer aussi un créateur virtuel je suis reparti sur un ancètre commun pour toutes mes classes qui rend virtuel le constructeur :

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
Type
  TMyObjectList = Class(TObjectList)
  Public
    Constructor create;Virtual;
  End;
 
  TMyObjectListClass = class of TMyObjectList;
...
{ TMyObjectList }
 
constructor TMyObjectList.create;
begin
  Inherited Create;
  OwnsObjects := True;
end;

Dans mon message plus haut il faut remplacer TClass par TMyObjectListClass.
Et bien sûr il ne faut stocker que des descendants de TMyObjectList dans la liste des classes .
L'opérateur IS perment ou cas ou de vérifier la descendance au moment de l'ajout.