Mettre de la couleur dans un TListView avec l'utilisation de l'apparence dynamique, par Serge Girard

Expert éminent sénior

Le 16/10/2017 à 10:30

Inté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 :

Sélectionner tout

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
122
procedure 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;

2

0

NABIL74

Membre confirmé

Le 15/10/2017 à 19:33

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 !

0

SergioMaster

Rédacteur/Modérateur

Le 25/09/2019 à 17:16

Bonjour,
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 :

Sélectionner tout

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
procedure 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 doigts

0

oneDev

Membre actif

Le 26/09/2019 à 15:13

Envoyé par SergioMaster

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 !

C'est "amusant" comme c'est souvent le cas. De gros bugs sont résolus avec si peu de code.

0

Identifiez-vous

Créer un compte

Mettre de la couleur dans un TListView

Avec l'utilisation de l'apparence dynamique, par Serge Girard

Identifiant
Mot de passe

Mot de passe oublié ?

Identifiez-vous

Créer un compte

Mettre de la couleur dans un TListView Avec l'utilisation de l'apparence dynamique, par Serge Girard

Mettre de la couleur dans un TListView

Avec l'utilisation de l'apparence dynamique, par Serge Girard