IdentifiantMot de passe
Mot de passe oublié ?Je m'inscris ! (gratuit)

Vous êtes nouveau sur Developpez.com ? Créez votre compte ou connectez-vous afin de pouvoir participer !

Vous devez avoir un compte Developpez.com et être connecté pour pouvoir participer aux discussions.

Vous n'avez pas encore de compte Developpez.com ? Créez-en un en quelques instants, c'est entièrement gratuit !

Si vous disposez déjà d'un compte et qu'il est bien activé, connectez-vous à l'aide du formulaire ci-dessous.

Identifiez-vous
Identifiant
Mot de passe
Mot de passe oublié ?
Créer un compte

L'inscription est gratuite et ne vous prendra que quelques instants !

Je m'inscris !

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

Le , par gvasseur58
4 commentaires

129PARTAGES

14  0 
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
Vous avez lu gratuitement 1 622 articles depuis plus d'un an.
Soutenez le club developpez.com en souscrivant un abonnement pour que nous puissions continuer à vous proposer des publications.

Une erreur dans cette actualité ? Signalez-nous-la !

4 commentaires
Commenter Signaler un problème
ShaiLeTroll
Avatar de ShaiLeTroll
Expert éminent sénior https://www.developpez.com
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


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.Caption, Critere) then
begin
TListView(Sender).Selected := TListView(Sender).Items;
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.Name := AName;
FColorArray.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.Name;
FColorArray[L + iWebColor].Value := ColorToRGB(Vcl.GraphUtil.WebNamedColors.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.Name;
GroupID := FColorArray.Value;
end;
end;

2  0 
NABIL74
Avatar de NABIL74
Membre confirmé https://www.developpez.com
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  0 
SergioMaster
Avatar de SergioMaster
Rédacteur/Modérateur https://www.developpez.com
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  0 
oneDev
Avatar de oneDev
Membre actif https://www.developpez.com
Le 26/09/2019 à 15:13
Citation Envoyé par SergioMaster Voir le message
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  0