Mettre de la couleur dans un TListView
Avec l'utilisation de l'apparence dynamique, par Serge Girard
Le 2017-10-14 11:38:04, par gvasseur58, Responsable Lazarus & Pascal
Chers membres du club,
Nous avons le plaisir de publier un nouveau tutoriel proposé par Serge Girard.
Mettre en exergue, via une couleur de fond, l'élément d'un TListView est une demande fréquemment formulée dans les forums consacrés à Delphi. Les solutions proposées ne sont pas toujours faciles à mettre en œuvre, car, contrairement à une liste simple de type TListBox, il n'est pas possible de passer par des styles personnalisés pour le faire.
L'apparition de l'apparence dynamique d'un élément de liste avec la version Berlin 10.1, ainsi que les compétences techniques et pédagogiques de Serge Girard vont vous permettre de résoudre ce problème très simplement !
http://serge-girard.developpez.com/t...ings/ListView/
Que pensez-vous de ce tutoriel ?
Quels problèmes rencontrez-vous dans la manipulation des couleurs et des contrôles avec Delphi ?
Retrouvez les meilleurs cours et tutoriels pour apprendre la programmation Delphi
Nous avons le plaisir de publier un nouveau tutoriel proposé par Serge Girard.
Mettre en exergue, via une couleur de fond, l'élément d'un TListView est une demande fréquemment formulée dans les forums consacrés à Delphi. Les solutions proposées ne sont pas toujours faciles à mettre en œuvre, car, contrairement à une liste simple de type TListBox, il n'est pas possible de passer par des styles personnalisés pour le faire.
L'apparition de l'apparence dynamique d'un élément de liste avec la version Berlin 10.1, ainsi que les compétences techniques et pédagogiques de Serge Girard vont vous permettre de résoudre ce problème très simplement !
http://serge-girard.developpez.com/t...ings/ListView/
-
ShaiLeTrollExpert éminent séniorIntéressant de voir à quel point la même chose avec un VCL TListView fait à l'ancienne n'a rien à voir avec un FMX TListView
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122procedure TZooXXXXVCLMainForm.lvColorsClick(Sender: TObject); begin if Assigned(TListView(Sender).Selected) then ShowMessage(TListView(Sender).Selected.Caption); end; procedure TZooXXXXVCLMainForm.lvColorsColumnClick(Sender: TObject; Column: TListColumn); var Critere: string; I: Integer; begin if InputQuery('Recherche', 'la couleur contient', Critere) then begin for I := 0 to TListView(Sender).Items.Count - 1 do begin if ContainsText(TListView(Sender).Items[I].Caption, Critere) then begin TListView(Sender).Selected := TListView(Sender).Items[I]; TListView(Sender).Selected.MakeVisible(False); Exit; end; end; end; end; procedure TZooXXXXVCLMainForm.lvColorsCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); function GetConstratedColor(AColor: TColor): TColor; var H, S, L: Word; begin ColorRGBToHLS(ColorToRGB(AColor), H, L, S); if L > 120 then begin if L < 168 then begin if H <= 140 then begin if (H in [0..20]) or (H in [220..240]) then Result := clWhite // Clair sur rouge else Result := clBlack // Foncé jaune et vert moyen end else Result := clWhite // Clair sur bleu ou violet moyen end else Result := clBlack // Foncé sur Clair end else begin if L > 90 then begin if (H in [0..20]) or (H in [48..240]) then begin if (S > 200) and (H in [48..128]) then Result := clBlack // Vert Citron else Result := clWhite // Clair sur Marron, Vert, Bleu et Pourpre end else Result := clBlack // Foncé sur le Jaune et Fuschia end else Result := clWhite; // Clair sur Foncé end; end; var ItemRect: TRect; ItemText: string; begin DefaultDraw := False; Sender.Canvas.Pen.Color := GetConstratedColor(Item.GroupID); Sender.Canvas.Brush.Color := Item.GroupID; ItemRect := Item.DisplayRect(drBounds); Sender.Canvas.FillRect(ItemRect); ItemText := Item.Caption; Sender.Canvas.Font.Color := GetConstratedColor(Item.GroupID); Sender.Canvas.TextRect(ItemRect, ItemText, [tfSingleLine, tfCenter, tfVerticalCenter]); end; procedure TZooXXXXVCLMainForm.ColorCallBack(const AName: String); var L: Integer; begin L := Length(FColorArray); SetLength(FColorArray, L + 1); FColorArray[L].Name := AName; FColorArray[L].Value := ColorToRGB(StringToColor(AName)); end; procedure TZooXXXXVCLMainForm.lvColorsDblClick(Sender: TObject); var iWebColor: Integer; I, L: Integer; begin SetLength(FColorArray, 0); TListView(Sender).Items.Clear(); Vcl.Graphics.GetColorValues(ColorCallBack); L := Length(FColorArray); SetLength(FColorArray, L + Length(Vcl.GraphUtil.WebNamedColors)); for iWebColor := Low(Vcl.GraphUtil.WebNamedColors) to High(Vcl.GraphUtil.WebNamedColors) do begin FColorArray[L + iWebColor].Name := Vcl.GraphUtil.WebNamedColors[iWebColor].Name; FColorArray[L + iWebColor].Value := ColorToRGB(Vcl.GraphUtil.WebNamedColors[iWebColor].Value); end; SortColorArray(FColorArray, Low(FColorArray), High(FColorArray), stSaturation); for I := Low(FColorArray) to High(FColorArray) do with TListView(Sender).Items.Add() do begin Caption := FColorArray[I].Name; GroupID := FColorArray[I].Value; end; end;
le 16/10/2017 à 10:30 -
NABIL74Membre confirméBonsoir,
Je tiens à remercier notre ami Serge d'avoir pris le temps de rédiger cet intéressant tutoriel. Il est toujours disponible ce vieux codeur
Ce tutoriel, je le trouve formidable ! Il est bien expliqué, clair et net.
Bravo
Encore merci !le 15/10/2017 à 19:33 -
SergioMasterRédacteur/ModérateurBonjour,
Même si le programme proposé était FMX, on m'a signalé (il y a peu) qu'il ne fonctionnait qu'uniquement en application de bureau et pas sur les mobiles
Tout d'abord une faute s'était glissé dans le zip, dans la version proposée le PrototypeBindSource n'a pas de champ Bitmap et donc pas de liaison, contrairement à ce qui est indiqué dans le texte du tutoriel. À la place un TBitmap était créé à l'exécution et ce pour chaque élément, ce qui nécessitait, au demeurant, un nettoyage en fin de programme.
Vous serez certainement heureux d'apprendre que j'ai enfin trouvé une solution à ce problème et ce en ajoutant une seule ligne de 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
27
28
29
30
31
32
33
34
35
36
37
38procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); var AListItemBitmap : TListItemImage; AListItemText : TListItemText; AColor : TAlphaColor; i : Word; begin AListItemBitmap:=AItem.Objects.FindObjectT<TListItemImage>('Image2'); {$IFNDEF STEP2} AListItemText:=AItem.Objects.FindObjectT<TListItemText>('Text1'); if Assigned(AListItemBitmap) then begin AListItemBitmap.OwnsBitmap:=True; // ici la modification AListItemBitmap.Bitmap:=TBitmap.Create(40,40); try AColor:=StringToAlphaColor(AListItemText.Text) except // certaines couleurs sont inconnues! i.e. monneygreen, ltgrey AColor:=TAlphaColorRec.Null; end; AListItemBitmap.Bitmap.Clear(Acolor); //:=ABitmap; end; {$ENDIF} {$IFDEF STEP2} if Assigned(AListItemBitmap) then begin AListItemBitmap.OwnsBitmap:=True; // ici la modification AListItemBitmap.Bitmap:=TBitmap.Create(40,40); i:=Abs(AItem.Text.ToInteger) mod 3; case i of 0 : AColor:=TAlphaColorRec.Green; 1 : AColor:=TAlphaColorRec.Yellow; 2 : AColor:=TAlphaColorRec.Red; end; AListItemBitmap.Bitmap.Clear(AColor); end; {$ENDIF} end;
Le fait d'indiquer que l'image appartient à l'élément (OwnsBitmap:=True) change tout et, cerise sur le gâteau, plus besoin de nettoyage en fin de programme.
Je vais tenter de modifier tutoriel via un addenda et les sources jointes, toutefois la rédaction de ces derniers avait été faite sur un disque qui a planté lors de ma présentation à Paris, croisez les doigtsle 25/09/2019 à 17:16 -
oneDevMembre actifC'est "amusant" comme c'est souvent le cas. De gros bugs sont résolus avec si peu de code.le 26/09/2019 à 15:13