Discussion :

[SergioMaster]

Bonjour,

Suite à la discussion précédente
j'arrive désormais à explorer les styles (cachés ou non) que ce soit en tant que fichier .style, .fsf ou même en .res.

ici, le style Gnome (oui, il existe, je l'ai "récupéré" avec le programme de la discussion précédente) et pourtant le programme est Windows32


Comme vous le constatez sur cette image, je suis capable d'afficher les images utilisées.

Pour certains styles je suis même capable de visualiser, plus ou moins correctement, quelques uns des éléments


Malheureusement ce n'est pas le cas de tous les éléments listés. Logique, ce ne sont pas que des contrôles visuels.

Ma première question du jour : comment savoir si un élément est un contrôle visuel . J'ai déjà distingué 3 cas TControl, TText, TImage

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
    if Assigned(Compo) then
    begin
      if compo is Tcontrol then
      begin
        if Assigned(Backg) then
        begin
          Back := Backg.Clone(Layout1) as TControl;
          Back.Align := TAlignLayout.Client;
          Back.Parent := Layout1;
          Back.HitTest:=false;
        end
        else
          Back := nil;
 
        var Comp := Compo.Clone(Layout1) as TControl;
        comp.Visible := true;
        Comp.Align := TAlignLayout.Center;
        comp.HitTest:=False;
        if Assigned(Backg) then
          comp.Parent := Back
        else
          Comp.Parent := Layout1;
      end;
 
    if compo is TText then
    begin
      var Comp := Compo.Clone(Layout1) as TText;
      comp.Visible := true;
      comp.Text := 'Hello World';
      comp.AutoSize := true;
      Comp.Align := TAlignLayout.Center;
      Comp.HitTest:=False;
      if Assigned(Backg) then
        comp.Parent := Back
      else
        Comp.Parent := Layout1;
    end;
 
    if compo is TImage then
    begin
      var comp := Compo.Clone(Layout1) as TImage;
      comp.Bitmap := comp.MultiResBitmap.Items[0].Bitmap;
      comp.Parent := Layout1;
      comp.Align := TalignLayout.Client;
      comp.Margins.Rect := TRect.Create(3, 3, 3, 3);
      comp.wrapmode := Timagewrapmode.Stretch;
      comp.HitTest:=False;
      comp.Visible := true; // je me suis fait avoir par défaut c'est false ! Du coup j'ai reproduit sur les autres types
    end;

Mais du coup, j'ai un certaine frustration, si je dois essayer de retrouver tous les types, quelle galère !
N.B. La plupart des éléments des styles Linux ne se dessine pas je ne sais pour quelle raison

Cela étant, j'obtiens bien le dessin mais pas vraiment ce que je cherche : le composant qui utilise l'élément de style.
Prenons l'exemple du bouton de l'image #2, elle a certainement un texte mais je suis incapable de le représenter.

Toute idée sera bienvenue.

[SergioMaster]

Rectification

N.B. La plupart des éléments des styles Linux ne se dessine pas je ne sais pour quelle raison

en fait le problème vient de la partie suivante : le background (en bleu la partie qui change tout)

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
    if Assigned(Compo) then
    begin
      if compo is Tcontrol then
      begin
        if Assigned(Backg) AND cbshowbackground.ischecked then
        begin
          Back := Backg.Clone(Layout1) as TControl;
          Back.Align := TAlignLayout.Client;
          Back.Parent := Layout1;
          Back.HitTest:=false;
        end
        else
          Back := nil;

        var Comp := Compo.Clone(Layout1) as TControl;
        comp.Visible := true;
        Comp.Align := TAlignLayout.Center;
        comp.HitTest:=False;
        if Assigned(Back) then
          comp.Parent := Back
        else
          Comp.Parent := Layout1;
      end;

Si je coche la case j'ai sous les styles Linux une propriété de background doit jouer (comme pour cette histoire d'image) !

[SergioMaster]

Si je coche la case j'ai sous les styles Linux une propriété de background doit jouer (comme pour cette histoire d'image) !

Cette partie est .
Effectivement en ouvrant le fichier .style

object TRectangle
StyleName = 'backgroundstyle'
Align = Contents
Fill.Color = xFFEDEDEC
HitTest = False
Size.Width = 804.000000000000000000
Size.Height = 938.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
Visible = False
end

ce Visible = False m'a fait des misères !

[SergioMaster]

Pour reprendre après la correction pour les styles Linux, j'en suis là


J'ai désormais ajouté les styles utilisés par chaque "sous-éléments" mais ensuite cela se corse, comment analyser ces divers "sous-styles" ?

je me suis lancé le défi d'utiliser les Rtti

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
procedure GetPropertiesList(const C : TFMXObject;const rank : integer);
  var
  ctx: TRttiContext;
  typ: TRttiType;
  valeur : string;
begin
  ctx:=TRttiContext.Create;
  try
  typ := ctx.GetType(c.ClassType);
  var prop := typ.GetProperties;
  if Assigned(prop) then
  begin
  for var S in prop do
   begin
     if S.IsReadable And (S.Visibility in [TMemberVisibility.mvPublic,TMemberVisibility.mvPublished]) then
       try valeur:=S.GetValue(C).ToString; except
                      valeur:=''; end;
     memo1.lines.add(Format('%s %s %s = %s',[StringOfChar(' ', (rank * 4)),'--',s.Name,valeur]));
   end;
  end;
  finally
    ctx.Free;
  end;
end;

Mais le résultat est addbuttonstyle.txt difficilement exploitable (sans parler du fait que j'ai quelques exceptions comme celles-ci

Classe d'exception EComponentError avec un message 'TStyleContainer n'a pas été recensé comme classe COM'
Classe d'exception EComponentError avec un message 'TLayout n'a pas été recensé comme classe COM'(24592)

certainement dues à une incompréhension de ma part dans le paramètre de S.GetValue ?

Question subsidiaire : vu l'utilisation "fréquente" de RttiContext, n'aurais-je pas intérêt à créer ce contexte pour tout le programme en variable gloable ?

[SergioMaster]

J'ai remplacé le mémo par un Treeview pour mieux visualiser la structure.
Je n'ai plus les erreurs depuis que j'ai remplacé le test de la ligne 15 du précédent code par

Code :

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

1
2
3
if S.IsReadable and S.IsWritable
            and (S.Visibility in [TMemberVisibility.mvPublic, TMemberVisibility.mvPublished])
            and (not S.GetValue(C).IsEmpty)

prochain objectif remplacer le treeview par une sorte d'éditeur.
Je sais déjà que vous pourriez me dire que des éditeurs de propriétés existent dans C:\Program Files (x86)\Embarcadero\Studio\<version>\source\Property Editors) mais celui que j'ai essayé ce matin FmxStyleLookup.pas s'utilise uniquement avec VCL
Mais, avant cela, il me faut concocter une sorte de grille

[Gouyon]

Bravo superbe boulot.

[tourlourou]

Comme quoi, l'opiniâtreté paye !
Malgré tout, c'est un travail de fourmi ou de moine copiste qui demande de la motivation : bravo !

[SergioMaster]

Merci à vous deux, cela fait chaud au cœur et donne de la motivation.

J'espère arriver au bout de cette idée, bien qu'aujourd'hui je bloque sur cet "éditeur" de propriétés.

[SergioMaster]

Bonjour,

je me suis dit que je pourrais utiliser un style différent pour l'item d'un treeview pour simuler un éditeur
j'ai donc déposer un nouveau style sur ma forme et créer ce style.


un petit peu de code plus tard

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
procedure GetPropertiesList(const C: TFMXObject; const Parent : TTreeviewItem);
  var
    typ: TRttiType;
    valeur: string;
  begin
      typ := ctx.GetType(c.ClassType);
      var prop := typ.GetProperties;
      if Assigned(prop) then
      begin
        for var S in prop do
        begin
          if S.IsReadable and S.IsWritable
            and (S.Visibility in [TMemberVisibility.mvPublic, TMemberVisibility.mvPublished])
            and (not S.GetValue(C).IsEmpty)
          then begin
            try
              valeur := S.GetValue(C).ToString;
            except valeur := '';
            end;
            if not Valeur.IsEmpty then
              begin
                var Item := TTreeViewItem.Create(Self);
                item.Parent:=Parent;
                Item.Text:=s.Name+'='+valeur; // histoire de vérifier le texte dans le TEdit
                item.StyleLookup:='treeviewitemeditstyle';
                item.ApplyStyleLookup;
                var aEdit:=Item.FindStyleResource('editvaleur');
                if assigned(aEdit) then Tedit(aEdit).text:=valeur;
              end;
        end;
       end;
      end;
 end;

excepté encore la "mise en page", (une histoire d'alignement à corriger dans mon style, les maxsize minsize me manquent), j'obtiens bien ce que je souhaitais

mais problème dés que je me déplace dans l'arborescence mes "valeurs à éditer" se mélangent


Où est-ce que je me plante ?
Quelqu'un a-t-il déjà essayé ce genre de truc (un treeview avec un tedit associé) ?

[SergioMaster]

Bonjour,

On aurait presque envie désormais de saisir des données et les appliquer (pour peu de rajouter les éditeurs nécessaires)


Mais comment faire pour accéder aux objets ?

[SergioMaster]

Je ne voulais pas une présentation "à plat" des éléments du volet gauche.

C'est désormais sur la bonne voie

bien que j'ai encore pas mal de boulot, dans ma première version, j'enlevais tout duplicata à ma liste et la liste était triée, ne pas le faire m'a fourni un nombre incroyable de glyphstyle
Je vais tenter de peaufiner la chose

[SergioMaster]

Des avancées, désormais je n'ai plus les soucis "d'arborescence".
mes plus grosses astuces furent de tester non pas le stylename mais le type de composant et de garder que les TImage et TLayout et de stocker cette recherche dans un TOrderedDictionary.


Reste qu'à présent, je tique sur l'ordre des 'enfants' (cf. les encadrés de l'image)
j'utilise cette procédure (pour la partie gauche)

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
procedure StylesEnfants(const C: TFMXObject;  inDicList: TOrderedDictionary<Integer, string>);
var
  ctx: TRttiContext;
  typ: TRttiType;
  valeur, p : string;
begin
  if C.ChildrenCount = 0 then exit;
  for var ccomp in C.Children do
  begin
    ctx := TRttiContext.Create;
    try
      typ := ctx.GetType(ccomp.ClassType);
      if Assigned(typ) then
      begin
        var prop := typ.GetProperties;
        if Assigned(prop) then
        begin
          for var S in prop do
          begin
            if S.HasName('stylename') then
            begin
              valeur := #9 + S.GetValue(Ccomp).ToString;
              if Not valeur.Trim.IsEmpty then inDicList.add(Ccomp.ComponentIndex ,Valeur);
            end;
          end;
        end;
      end;
    finally
      ctx.free;
    end;
  end;
end;

Mais GetProperties ne me fourni pas vraiment un ordre alphabétique c'est quand même rageant, quand on n'en veux pas (par exemple lorsque je travaillais sur un dbnavigateur colorisé j'avais un ordre alphabetique que je voulais squizzer) l'ordre est appliqué et là je ne sais même pas de quel ordre il s'agit.
Bon il y a certainement moyen de s'en sortir élégament en passant par un "sous dictionnaire" et un tri mais , là, je suis un peu trop colère pour le faire

Pour ce qui est du panneau gauche, idem. Dans ce panneau j'utilise un TStringGrid remplies via ce code

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
 procedure GetPropertiesList(const C: TFMXObject; rank: integer);
  var
    ctx: TRttiContext;
    typ: TRttiType;
    valeur: string;
  begin
    ctx := TRttiContext.Create;
    try
      typ := ctx.GetType(c.ClassType);
      var prop := typ.GetProperties;
      if Assigned(prop) then
      begin
        for var S in prop do
        begin
          if S.IsReadable and S.IsWritable
            and (S.Visibility in [TMemberVisibility.mvPublic,
              TMemberVisibility.mvPublished])
            and (not S.GetValue(C).IsEmpty) then
          begin
            try
              valeur := S.GetValue(C).ToString;
            except valeur := '';
            end;
            if not Valeur.IsEmpty then
            begin
              var row := StringGrid1.rowCount;
              StringGrid1.rowCount := StringGrid1.RowCount + 1;
              StringGrid1.Cells[0, row] := StringOfChar(#9, rank) + S.name;
              StringGrid1.Cells[1, row] := Valeur;
              StringGrid1.Cells[2, row] := S.PropertyType.ToString;
            end;
          end;
        end;
      end;
    finally
      ctx.free;
    end;
  end;
 
  procedure compolist(const C: TFMXObject; rank: Integer = 0);
  begin    var row := StringGrid1.rowCount;
    StringGrid1.rowCount := StringGrid1.RowCount + 1;
    StringGrid1.Cells[0, row] := Format('%s+%s', [stringofchar(#9, rank),
        C.ClassName.PadRight(30)]);
    GetPropertiesList(C, rank + 1);
    if (C is Tcontrol) and (C.ChildrenCount > 0) then
    begin
      for var ccomp in C.Children do compolist(ccomp, rank + 1);
    end;
  end;

Là aussi la faute est le GetProperties non "ordonné".

Si quelqu'un a une astuce pour remplacer GetProperties par quelque chose d'autre (permettant d'obtenir les valeurs) ?
P.S. j'ai vu GetPropertiesInDeclOrder mais je ne suis pas sûr du résultat (pas trouvé la doc sur cette fonction et pas de commentaires dans les sources !)

[anapurna]

salut

dis en réfléchissant bêtement Prop c'est bien un

Code :

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

array<TRttiProperty>

si c'est le cas j'aurais juste implémenté un sort au array

genre :

Code :

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

1
2
Tarray.Sort<TRttiProperty>(prop,TComparer<TRttiProperty>.Construct(function (const A, B: TRttiProperty): Integer
          begin Result := string.CompareText(A.name, B.name); end ));

[SergioMaster]

L'idée est excellente, je n'osais pas.
Avec les RTTI je marche sur la pointe des pieds, mais après tout le tableau est un résultat, je vais donc tenter cette approche élégante

[SergioMaster]

Élégant, mais saoulant !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure SortRttiPropertiesByNameIgnoreCase(var Properties: TArray<TRttiProperty>);
begin
  TArray.Sort<TRttiProperty>(Properties,
    TComparer<TRttiProperty>.Construct(
      function(const Left, Right: TRttiProperty): Integer
      begin
        Result := CompareText(Left.Name, Right.Name);
      end
    )
  );
end;

en soit c'était correct mais sans System.Generics.Defaults dans la liste des uses je n'arrivais pas à le compiler et l'erreur

E2250 Aucune version surchargée de 'TArray.Sort<System.Rtti.TRttiProperty>' ne peut être appelée avec ces arguments

n'était pas vraiment explicite.
Passons, désormais le tri fonctionne mais je ne comprends pas un truc : j'ai des doublons !

AbsoluteClipRect
AbsoluteEnabled
AbsoluteHeight
AbsoluteMatrix
AbsoluteOpacity
AbsoluteRect
AbsoluteScale
AbsoluteWidth
ActionClient
Align
Align
Anchors
Anchors
ApplyingEffect
AutoCapture
AutoSize
AxisAlignedRect
BoundsRect
CanFocus
CanParentFocus
Canvas
Children
ChildrenCount
ChildrenRect
ClipChildren
ClipChildren
ClipParent
ClipParent
ClipRect
Color
ComObject
ComponentCount
ComponentIndex
ComponentState
ComponentStyle
Controls
ControlsCount
Cursor
Cursor
CustomSceneAddRect
Data
DefaultSize
DesignInfo
DisableDisappear
DisableFocusEffect
DragMode
DragMode
Enabled
Enabled

un petit programme "indépendant"
Project2.zip
me donne la même chose le fait de faire le tri met simplement le tuc en exergue

[papyvore]

Salut , je ne sais pas pourquoi il y a des doublons , j'ai eu le même problème en listant les contacts (pour android) et j'avais résolu le problème avec TDictionary ce qui donnerait pour ton prog

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
procedure TForm2.Button1Click(Sender: TObject);
var
  ctx: TRttiContext;
  typ: TRttiType;
  prop: TArray<TRttiProperty>;
  NameListe: TDictionary<String, Boolean>;
  NameKey: string;
 
  procedure SortRttiPropertiesByNameIgnoreCase(var Properties: TArray<TRttiProperty>);
  begin
    TArray.Sort<TRttiProperty>(Properties, TComparer<TRttiProperty>.Construct(
      function(const Left, Right: TRttiProperty): Integer
      begin
        Result := CompareStr(Left.Name, Right.Name);
      end));
  end;
 
begin
  Memo1.lines.clear;
  Memo2.lines.clear;
  ctx := TRttiContext.Create;
  try
    typ := ctx.GetType(Button1.ClassType);
    if Assigned(typ) then
    begin
      prop := typ.GetProperties;
 
      for var s in prop do
        Memo1.lines.add(s.Name);
 
      NameListe := TDictionary<String, Boolean>.Create;
      SortRttiPropertiesByNameIgnoreCase(prop);
      for var t in prop do
      begin
        // Créer une clé unique pour éviter les doublons
        NameKey := t.Name;
        if not NameListe.ContainsKey(NameKey) then
        begin
          NameListe.add(NameKey, True);
          Memo2.lines.add(t.Name);
        end;
      end;
 
    end;
  finally
    ctx.free;
   NameListe .free;
  end;
end;

mais ça ne ne résout pas la question pourquoi ? et pas sur non plus que ce soit une bonne solution

[anapurna]

Salut

c'est effectivement bizarre as tu essayé de faire un trim sur les noms et les mettre en minuscule afin
d'etre sur de comparer les base identique ?

[SergioMaster]

@papyvore je voulais éviter d'en passer par là (je garde sous le coude)
@anapurna le trim ne change rien

[SergioMaster]

Bonjour,

Dormir dessus est souvent un bon remède. Ayant écarté une erreur de la routine de tri du TArray<TRttiProperty>, je me suis dit que c'était un problème d'obtention.
Dans mes premiers essais j'avais un test concernant le volet gauche

Code :

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

1
2
 if S.HasName('stylename') AND  S.IsReadable and S.IsWritable
            and (S.Visibility in [TMemberVisibility.mvPublic,TMemberVisibility.mvPublished]) then

que j'avais réduit à simplement

Code :

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

if S.HasName('stylename') then

Dans le volet de droite (et dans mon petit programme test) j'avais carrément omis ce dernier puisque je ne voulais aucun test sur les noms de propriétés.

Vous devinez la suite ? Ce qui m'a mis la puce à l'oreille, TMemberVisibility.mvPublished, une fois le test sur la visibilité modifiée, plus de doublons.

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
procedure TForm2.Button1Click(Sender: TObject);
var
  ctx: TRttiContext;
  typ: TRttiType;
  prop : TArray<TRttiProperty>;
begin
   memo1.lines.clear;
   ctx := TRttiContext.Create;
   try
    typ := ctx.GetType(Trectangle);
    if Assigned(typ) then
      begin
        prop := typ.GetProperties;
        SortRttiPropertiesByNameIgnoreCase(prop);
        for var s in prop do
          if  S.IsReadable and S.IsWritable
            and (S.Visibility in [TMemberVisibility.mvPublic])
         then memo1.lines.add(s.Name);
      end;
   finally
     ctx.free;
   end;
end;

et voilà le résultat


Je vais marquer cette discussion comme résolue (ce programme ne nécessite que quelques peaufinements, si vous en voulez les sources, un petit mp avec adresse mail et je fais suivre le .zip) et en ouvrir deux autres pour la suite.
Sujets :

1. Modifier les valeurs des propriétés au runtime (et sauvegarder le "nouveau" style). Ceci va inclure un truc qui me gêne : les textes qui ne se montrent pas comme, par exemple, ici
2. Traiter les sélections dans l'image de référence (quand il y en a une)

[Charly910]

Bravo Serge, super travail !
A+
Charly