Problème de création d'une list box avec un style customisé

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous

J'ai besoin de faire une listbox dont les éléments sont composé d'une image de texte et de combobox voilà ce à quoi ça doit ressembler

Pièce jointe 584439

J'ai donc créé un stylebook contenant mes éléments de style
Pièce jointe 584440

Et voici la procédure que j'utilise pour remplir ma liste

Précisions:
lbgrpfeux est la TListBox sur ma fiche et que je dois peupler.
grpF , trl, navC, navEnMain sont des objects qui contiennent les informations à afficher dans la listbox.

Code:

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
 
procedure TForm2.majListeGrpFeux;
var
  i, ii: integer;
  item: TListBoxItem;
  FMXObject: TFMXObject;
  img: TImage;
  txt: TText;
  bmp: TBitmap;
  grpF: TGroupeFeu;
  trl: TTourelle;
  cbos, cbot, cbts: TComboBox;
  navC: TNavire;
  dist, angT: integer;
begin
  lbgrpfeux.Clear;
  i := 0;
  grpF := navEnMain.getGroupeFeu(i);
  while grpF <> nil do
  begin
    trl := grpF.getTourelle;
    item := TListBoxItem.Create(nil);
    item.Height := 60;
    item.Parent := lbgrpfeux;
    if trl.getCategorie = surf then
    begin
      item.StyleLookup := 'elemGrpFeuxS';
      FMXObject := item.FindStyleResource('txtaffuts_S');
      if (FMXObject <> nil) and (FMXObject is TText) then
      begin
        txt := TText(FMXObject);
        txt.Text := Format('%.2d', [grpF.getNbAffut]);
      end;
      FMXObject := item.FindStyleResource('txtcalibre_S');
      if (FMXObject <> nil) and (FMXObject is TText) then
      begin
        txt := TText(FMXObject);
        txt.Text := calibres_surf[grpF.getCalibre];
      end;
      FMXObject := item.FindStyleResource('cbobjectifs_S');
      if (FMXObject <> nil) and (FMXObject is TComboBox) then
      begin
        cbos := TComboBox(FMXObject);
        cbos.Clear;
        cbos.Items.AddObject('---------', nil);
        for ii := 0 to lesNavires.Count - 1 do
        begin
          navC := TNavire(lesNavires.Items[ii]);
          if (navC <> navEnMain) and (navC.getCamp <> navEnMain.getCamp) then
          begin
 
            if navEnMain.tirPossible(navC, trl) then
            begin
              cbos.Items.AddObject(navC.getNom, navC);
            end;
          end;
        end;
        cbos.ItemIndex := 0;
      end;
    end;
 
    if trl.getCategorie = torp then
    begin
      item.StyleLookup := 'elemGrpFeuxT';
      FMXObject := item.FindStyleResource('cbtaillesalve_T');
      if (FMXObject <> nil) and (FMXObject is TComboBox) then
      begin
        cbts := TComboBox(FMXObject);
        cbts.Clear;
        for ii := 1 to grpF.getNbAffut do
        begin
          cbts.Items.Add(Format('%d', [ii]));
        end;
        cbts.ItemIndex := grpF.getNbAffut - 1;
      end;
      FMXObject := item.FindStyleResource('txtcalibre_T');
      if (FMXObject <> nil) and (FMXObject is TText) then
      begin
        txt := TText(FMXObject);
        txt.Text := calibres_torp[grpF.getCalibre];
      end;
      FMXObject := item.FindStyleResource('cbobjectifs_T');
      if (FMXObject <> nil) and (FMXObject is TComboBox) then
      begin
        cbot := TComboBox(FMXObject);
        cbot.Clear;
        cbot.Items.AddObject('---------', nil);
        for ii := 0 to lesNavires.Count - 1 do
        begin
          navC := TNavire(lesNavires.Items[ii]);
          if (navC <> navEnMain) and (navC.getCamp <> navEnMain.getCamp) then
          begin
            if navEnMain.tirPossible(navC, trl) then
            begin
              cbot.Items.AddObject(navC.getNom, navC);
            end;
          end;
        end;
        cbot.ItemIndex := 0;
      end;
 
    end;
    inc(i);
    grpF := navEnMain.getGroupeFeu(i);
  end;
end;

Le soucis c'est que les différents éléments (Text et combobox) ne sont pas correctement mis à jour.
J'ai l'impression que l'object FMXObject que je récupère est toujours le même.

22/11/2020, 10h06
SergioMaster

Bonjour,

Il ne manquerait pas un Item.ApplyStyleLookup après le "item.StyleLookup := 'xxxxxxx'" ?
Je n'en suis pas sûr à 100% mais il me semble qu'indiquer seulement StyleLookup ne le fait pas "automatiquement" et j'avoue avoir un peu la flemme de tester.

L'autre solution serait d'utiliser Item.StylesData[] pour modifier les textes plutôt que FindStyleResource mais ce qu'il va falloir écrire comme nom entre les [] :roll:
j'imagine quelque chose comme Item.StylesData['lycbstyle_t.cbtailllesalve_t.Text']:= mais pour remplir le combobox :calim2: galère !
23/11/2020, 13h36
Gouyon

Je viens de tester le Item.ApplyStyleLookup mais ça n'a aucun effet.:(

J'avais vu quelque part l'usage de Item.StylesData[] et effectivement c'est moins lourd pour tout ce qui est texte.
Par contre pour le combobox je passe par FMXObject

1 pièce(s) jointe(s)

Bonjour,

Je n'ai pas encore d'applicatif qui pourrait nécessiter ce genre de chose. Par contre, comme je ne voit aucun Livebinding qui pourrait "troubler" la donne pourquoi ne pas, au lieu d'utiliser un TListbox, utiliser un TScrollBox (TVerticalScrollBox plus exactement) et une frame par style ? (Là j'ai un exemple tout frais ;))
D'ailleurs un TListBox n'est qu'un TVerticalScrollBox spécialisé

Pièce jointe 584950
ici j'ai 3 frames différentes (pas encore optimisées, pour TFGrid je songe mettre la requête au sein de la frame et créér les TButton à l'intérieur)

Code:

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
 
procedure TMainForm.prepareSQL;
var p : Double;
    AItem : TButton;
begin
with TFSQL.Create(Self) do
 begin
   Name:='Nom';
   Colonne.Text:='Nom';
   Parent:=ListeChoix;
   Position.Y:=0;
   P:=Size.Height;
   TagString:='A.NOM';
 end;
...
with TFTStock.Create(Self) do
 begin
   Name:='TYPESTOCK';
   Parent:=ListeChoix;
   Position.Y:=P;
   P:=P+Size.Height;
   TagString:='A.TYPE';
 end;
....
with TFGrid.Create(Self) do
   begin
     Name:='LigneProd';
     Colonne.Text:='Ligne Produit';
     Parent:=ListeChoix;
     Position.Y:=P;
     FDQuery1.Open('SELECT CODE_LIGNE,LIBELLE_LIGNE FROM LIGNPROD '+
                   'WHERE CHAR_LENGTH(TRIM(LIBELLE_LIGNE))>0 ORDER BY 2');
     GridListe.ItemWidth:=GridListe.Width/3;
     while not FDQuery1.EOF do
           begin
             AItem:=TButton.Create(Self);
             AItem.StaysPressed:=True;
             AItem.TextSettings.HorzAlign:=TTextAlign.Leading;
             AItem.Text:=FDQuery1.FieldByName('CODE_LIGNE').AsString+' - '+FDQuery1.FieldByName('LIBELLE_LIGNE').AsString;
             AItem.TagString:=FDQuery1.FieldByName('CODE_LIGNE').AsString;
             AItem.OnClick:= btnClick;
             GridListe.AddObject(AItem);
             FDQuery1.Next;
           end;
     Size.Height:=20 +((FdQuery1.RecordCount div 3)+1)*GridListe.ItemHeight;
     FDQuery1.Close;
     P:=P+Size.Height;
     FDQuery1.Close;
     TagString:='M.LIGNEPROD';
   end;
....

Toutefois j'ai testé à peu près à partir de ces mêmes "styles" ce code

Code:

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
 
procedure TMainForm.Button1Click(Sender: TObject);
var Item : TListBoxItem;
    i : integer;
begin
for i := 1 to 3 do
 begin
    item := TListBoxItem.Create(nil);
    item.Parent:=ListBox1;
    item.StyleLookup:='ColonneChaine';
    item.Height:=30;
    Item.Text:='Nom'+i.ToString;
    Item.NeedStyleLookup;
    Item.OnApplyStyleLookup:=StyleA;
 end;
end;
 
procedure TMainForm.StyleA(Sender: TObject);
    var acbx : TCombobox;
         FMXObject: TFMXObject;
    begin
     FMXObject := TListBoxItem(Sender).FindStyleResource('critere');
     if Assigned(FMXObject) AND (FMXObject is TCombobox)
        then showmessage('gagné')
        else showmessage('perdu');
    end;

là, c'est "gagné", je veux écrire par là que j'accéde au combobox de style critere (j'ai d'ailleurs pu remplir ce combobox sans difficulté par la suite).

donc, pour l'instant Item.NeedStyleLookup; c'est nécessaire et non ApplyStyleLookup comme j'avais pu l'écrire dans mon premier post.

Effectivement ça fonctionne
Par contre j'ai du passer par la propriété tag pour pouvoir récupérer l'object qui permet de configurer les éléments de chaque ligne de la liste car les deux procédures setStyle ne sont appelée qu'à la fin de la procédure de création de la liste.

Voici ce que j'ai écrit

les deux procédure pour chaque style

Code:

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
 
procedure TForm2.setStyleA(Sender: TObject);
var
  FMXObject: TFMXObject;
  txt: TText;
  cbos: TComboBox;
  i, ii: integer;
  navC: TNavire;
  lgrpF: TGroupeFeu;
begin
  i := TListBoxItem(Sender).Tag;
  lgrpF := navEnMain.getGroupeFeu(i);
  FMXObject := TListBoxItem(Sender).FindStyleResource('txtaffuts_S');
  if (FMXObject <> nil) and (FMXObject is TText) then
  begin
    txt := TText(FMXObject);
    txt.Text := Format('%.2d', [lgrpF.getNbAffut]);
  end;
  FMXObject := TListBoxItem(Sender).FindStyleResource('txtcalibre_S');
  if (FMXObject <> nil) and (FMXObject is TText) then
  begin
    txt := TText(FMXObject);
    txt.Text := calibres_surf[lgrpF.getCalibre];
  end;
  FMXObject := TListBoxItem(Sender).FindStyleResource('cbobjectifs_S');
  if (FMXObject <> nil) and (FMXObject is TComboBox) then
  begin
    cbos := TComboBox(FMXObject);
    cbos.Clear;
    cbos.Items.AddObject('---------', nil);
    for ii := 0 to lesNavires.Count - 1 do
    begin
      navC := TNavire(lesNavires.Items[ii]);
      if (navC <> navEnMain) and (navC.getCamp <> navEnMain.getCamp) then
      begin
        if navEnMain.tirPossible(navC, lgrpF.getTourelle) then
        begin
          cbos.Items.AddObject(navC.getNom, navC);
        end;
      end;
    end;
    cbos.ItemIndex := 0;
  end;
 
end;
 
procedure TForm2.setStyleT(Sender: TObject);
var
  FMXObject: TFMXObject;
  txt: TText;
  cbts, cbot: TComboBox;
  i, ii: integer;
  navC: TNavire;
  lgrpF: TGroupeFeu;
begin
  i := TListBoxItem(Sender).Tag;
  lgrpF := navEnMain.getGroupeFeu(i);
  FMXObject := TListBoxItem(Sender).FindStyleResource('cbtaillesalve_T');
  if (FMXObject <> nil) and (FMXObject is TComboBox) then
  begin
    cbts := TComboBox(FMXObject);
    cbts.Clear;
    for ii := 1 to lgrpF.getNbAffut do
    begin
      cbts.Items.Add(Format('%d', [ii]));
    end;
    cbts.ItemIndex := lgrpF.getNbAffut - 1;
  end;
  FMXObject := TListBoxItem(Sender).FindStyleResource('txtcalibre_T');
  if (FMXObject <> nil) and (FMXObject is TText) then
  begin
    txt := TText(FMXObject);
    txt.Text := calibres_torp[lgrpF.getCalibre];
  end;
  FMXObject := TListBoxItem(Sender).FindStyleResource('cbobjectifs_T');
  if (FMXObject <> nil) and (FMXObject is TComboBox) then
  begin
    cbot := TComboBox(FMXObject);
    cbot.Clear;
    cbot.Items.AddObject('---------', nil);
    for ii := 0 to lesNavires.Count - 1 do
    begin
      navC := TNavire(lesNavires.Items[ii]);
      if (navC <> navEnMain) and (navC.getCamp <> navEnMain.getCamp) then
      begin
        if navEnMain.tirPossible(navC, lgrpF.getTourelle) then
        begin
          cbot.Items.AddObject(navC.getNom, navC);
        end;
      end;
    end;
    cbot.ItemIndex := 0;
  end;
end;

La procedure de création de la liste

Code:

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 TForm2.majListeGrpFeux;
var
  i: integer;
  item: TListBoxItem;
  lgrpF: TGroupeFeu;
begin
  lbgrpfeux.Clear;
  i := 0;
  lgrpF := navEnMain.getGroupeFeu(i);
  while lgrpF <> nil do
  begin
    item := TListBoxItem.Create(nil);
      item.Tag := i;
      item.Height := 60;
      item.Parent := lbgrpfeux;
    if lgrpF.getTourelle.getCategorie = surf then
    begin
      item.StyleLookup := 'elemGrpFeuxS';
      item.NeedStyleLookup;
      item.OnApplyStyleLookup := setStyleA;
    end;
    if lgrpF.getTourelle.getCategorie = torp then
    begin
      item.StyleLookup := 'elemGrpFeuxT';
      item.NeedStyleLookup;
      item.OnApplyStyleLookup := setStyleT;
    end;
    inc(i);
    lgrpF := navEnMain.getGroupeFeu(i);
  end;
end;