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