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
123
|
//Pour simuler un gros Set de couleurs :
type tSetBmpOfTColors = Object //Class
bmp : tBitMap; R,G,B : byte;
procedure Create;
procedure Add(inVal : TColor);
procedure Delete(inVal : TColor);
function Contains(testVal : TColor) : boolean;
//procedure AddSet(inSet : tSetBmpOfTColors); <- à faire éventuellement Set1 = Set1 + Set2
procedure Free;
end;
implementation
{$R *.DFM}
// Version Bmp :
procedure tSetBmpOfTColors.Create;
begin Bmp:=tBitMap.create;
with Bmp do
begin height:=256; width:=256;
pixelFormat:=pf24bit;
Canvas.Brush.Color:=RGB(1,1,1);
Canvas.FillRect(Rect(0,0,width,height));
end;
end;
type tRGBTripleArray = array [WORD] of tRGBTriple;
pRGBTripleArray = ^tRGBTripleArray;
procedure tSetBmpOfTColors.Add(inVal : TColor);
var rangee: pRGBTripleArray; i : integer;
begin R:=GetRValue(inVal);
G:=GetGValue(inVal);
B:=GetBValue(inVal);
with bmp do
begin rangee := Scanline[R]; // on range directement dans la ligne d'indice R
i:=-1;
repeat inc(i);
until (i=width-1)
or ((rangee[i].rgbtGreen=1) and (rangee[i].rgbtBlue=1))
or ((rangee[i].rgbtGreen=G) and (rangee[i].rgbtBlue=B));
rangee[i].rgbtRed:=R; rangee[i].rgbtGreen:=G; rangee[i].rgbtBlue:=B;
end;
end;
procedure tSetBmpOfTColors.Delete(inVal : TColor);
var rangee: pRGBTripleArray; i : integer;
begin R:=GetRValue(inVal);
G:=GetGValue(inVal);
B:=GetBValue(inVal);
with bmp do
begin rangee := Scanline[R]; // on va directement dans la ligne d'indice R
i:=0;
while (i<width-1) and (rangee[i].rgbtGreen<>G) and (rangee[i].rgbtBlue<>B)
do inc(i);
rangee[i].rgbtRed:=1; rangee[i].rgbtGreen:=1; rangee[i].rgbtBlue:=1;
end;
end;
function tSetBmpOfTColors.Contains(testVal : TColor) : boolean;
var rangee: pRGBTripleArray; i : integer;
begin R:=GetRValue(testVal);
G:=GetGValue(testVal);
B:=GetBValue(testVal);
with bmp do
begin rangee := Scanline[R]; // on saute directement sur la ligne d'indice R
i:=-1;
repeat inc(i);
if (rangee[i].rgbtGreen = G)
and (rangee[i].rgbtBlue = B)
and (rangee[i].rgbtRed = R)
then begin RESULT:=true; EXIT; end;
until (i=width-1);
end;
RESULT:=false;
end;
procedure tSetBmpOfTColors.Free;
begin Bmp.Free; end;
// Utilisation version Bmp
procedure TfrmSetOf.bSetBmpClick(Sender: TObject);
var SetBmp : tSetBmpOfTColors;
begin memo1.clear;
SetBmp.Create;
SetBmp.Add(clGreen);
SetBmp.Add(clRed);
SetBmp.Add(RGB(44,255,22));
SetBmp.Add(RGB(255,255,22));
SetBmp.Add(clLime);
SetBmp.Add(RGB(255,128,255));
if SetBmp.Contains(clRed) then showMessage('1 : Rouge présent : ok')
else showMessage('1 : Rouge absent');
if SetBmp.Contains(clGreen) then showMessage('1 : Vert présent : ok')
else showMessage('1 : Vert absent');
if SetBmp.Contains(clYellow) then showMessage('2 : Jaune présent')
else showMessage('2 : Jaune absent : ok');
SetBmp.Add(clYellow);
if SetBmp.Contains(clYellow) then showMessage('3 : Jaune présent : ok')
else showMessage('3 : Jaune absent');
if SetBmp.Contains(RGB(43,255,22)) then showMessage('4 : 43,255,22 présent')
else showMessage('4 : 43,255,22 absent : ok');
if SetBmp.Contains(RGB(44,255,22)) then showMessage('5 : 44,255,22 présent : ok')
else showMessage('5 : 44,255,22 absent');
SetBmp.Delete(clRed);
if SetBmp.Contains(clRed) then showMessage('6 : Rouge présent')
else showMessage('6 : Rouge absent : ok');
if SetBmp.Contains(clYellow) then showMessage('7 : Jaune présent : ok')
else showMessage('7 : Jaune absent');
SetBmp.Free;
end; |
Répondre avec citation
que ce soit Include, Exclude ou Exists qui posaient toujours problème.
Envoyé par Cl@udius
Evidemment !
Partager