Mettre de la couleur dans un TListView

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;