RWolfЭто просто сумма арифметической прогрессии:
Благодарю, то что нужно.
Собрал строки в двумерный массив и скорость проверки стала немного меньше: (588х449 - 0,25 сек) (2560х1600 - 3,3 сек)
Вот что получилось:
Программа, с примером
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.
unit Unit3;
interface
uses
System.StrUtils, // Для замены строк AnsiReplace, PosEx
Math // Для округления чисел
type
TForm3 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ColorInMass; // Загрузить свойства цвета из текстового документа
private
{ Private declarations }
public
{ Public declarations }
end;
ColorProperties = record // Свойства цвета
BGW:byte; // Если "R=G=B" то BGW=0, иначе BGW=1
Bright:extended; // Яркость
Shade:integer; // Оттенок (Цвет)
Contrast, // Контрастность
Triangle, // Номер треугольника
CountCell, // Количество ячеек, в треугольнике, в ряду "Contrast"
Cell // Номер ячейки, в треугольнике, в ряду "Contrast"
// CountRow // Количество рядов, на яркости "Bright"
:byte;
Num, // Номер цвета
FullNum // Номер полного имени цвета
:integer;
Name, // Имя цвета
FullName // Полное имя цвета (по яркости)
: string;
end;
ColorNum = record // Номер цвета
Num, // Xman - Оттенок (Координата по оси X, на общей сетке координат)
Name, // Номер названия цвета "Красный"
FullName // Номер полного названия цвета "Черный |с красным оттенком|"
:Integer;
end;
var
Form3: TForm3;
ColorProperty : array of array of ColorNum; // Номер цвета
NameOfColor : array of array of string; // Название цвета по номеру
implementation
{$R *.dfm}
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.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
procedure TForm3.ColorInMass; // Загрузить свойства цвета из текстового документа
var
LoadColor:TStringList;
Pp1,Pp2,i,l,Pp1a,Pp2a,
Pp1b,Pp2b,Pp1c,Pp2c,
Pp1d,Pp2d,Pp1e,Pp2e,
Pp1f,Pp2f,Pp1g,Pp2g,Pp1h,Pp2h,n5,n6,n7,
LastPart1,LastPart2,D,D2,TheBright,
TheContrast,NumberLine:integer;
s,ss,LoadColorS:string;
begin
if FileExists(GetCurrentDir+'\AllBrights.txt') then // Если выбранный файл существует
begin
LoadColor:=TStringList.Create;
LoadColor.LoadFromFile(GetCurrentDir+'\AllBrights.txt'); // Открыть текстовый документ
LoadColorS := LoadColor.Text;
// ДЛИНА МАССИВА //////////////////////////////////////////////////////////////
Pp1 := AnsiPos('(Количество названий=',LoadColorS);
Pp2 := PosEx(')',LoadColorS,Pp1+1);
if (Pp1>0) and (Pp2>0) then
begin
l := length('(Количество названий=');
LastPart1 := strtointdef(copy(LoadColorS,Pp1+l,Pp2-Pp1-l),1);
setlength(ColorProperty,32896,LastPart1); // Указать длину массива "ColorProperty"
setlength(NameOfColor,LastPart1,0); // Указать длину массива, названий "NameOfColor"
end;
// НАЗВАНИЯ ЦВЕТА В МАССИВ "NameOfColor" //////////////////////////////////////
LastPart1 := 0;
Pp1 := AnsiPos('Название цвета по номеру: (Количество названий=',LoadColorS);
Pp2 := PosEx('Массив значений: ***********************',LoadColorS,Pp1);
if (Pp1>0) and (Pp2>0) then
begin
s := copy(LoadColorS,Pp1,Pp2-Pp1);
Pp1a := PosEx('('+inttostr(LastPart1)+') ''',s,1);
Pp2a := PosEx('('+inttostr(LastPart1+1)+') ''',s,Pp1a+1);
if Pp2a=0 then Pp2a := s.Length;
repeat
if (Pp1a>0) and (Pp2a>0) then
begin
LastPart2 := 0;
Pp1b := PosEx('_'+inttostr(LastPart2)+'_ ''',s,Pp1a);
Pp2b := PosEx('_'+inttostr(LastPart2+1)+'_ ''',s,Pp1b+1);
if (Pp2b=0) or (Pp2b>Pp2a) then Pp2b := Pp2a;
if (Pp1b>0) and (Pp2b>0) then
begin
setlength(NameOfColor[LastPart1],1); // Указать длину массива названий
ss := copy(s,Pp1a,Pp1b-Pp1a-2);
Pp1c := PosEx('''',ss,1);
Pp2c := ss.Length-PosEx('''',AnsiReverseString(ss),1) +1;
NameOfColor[LastPart1,0] := copy(ss,Pp1c+1,Pp2c-Pp1c-1);
end;
repeat
LastPart2 := LastPart2+1;
if (Pp1b>0) and (Pp2b>0) then
begin
setlength(NameOfColor[LastPart1],LastPart2+1); // Указать длину массива названий
ss := copy(s,Pp1b,Pp2b-Pp1b-2);
Pp1c := PosEx('''',ss,1);
Pp2c := ss.Length-PosEx('''',AnsiReverseString(ss),1) +1;
NameOfColor[LastPart1,LastPart2] := copy(ss,Pp1c+1,Pp2c-Pp1c-1);
end;
Pp1b := Pp2b;
Pp2b := PosEx('_'+inttostr(LastPart2+1)+'_ ''',s,Pp1b+1);
if (Pp2b=0) or (Pp2b>Pp2a) then Pp2b := Pp2a;
until (Pp1b=0) or (Pp2b=0) or (Pp1b=Pp2b);
end;
LastPart1 := LastPart1+1;
Pp1a := Pp2a;
Pp2a := PosEx('('+inttostr(LastPart1+1)+') ''',s,Pp1a+1);
if Pp2a=0 then Pp2a := s.Length;
until (Pp1a=0) or (Pp2a=0) or (Pp1a=Pp2a);
end;
// ЗНАЧЕНИЯ ЦВЕТА В МАССИВ "ColorProperty" ////////////////////////////////////
NumberLine := 0; // Номер ячейки в массиве
Pp1 := AnsiPos('Массив значений: ***************************',LoadColorS);
Pp2d := Pp1;
if Pp1>0 then
begin
for D := 0 to 1 do
for TheBright := 0 to 254-D do
begin
D2 := Floor(TheBright/127)*D;
for TheContrast := abs(127-TheBright)+D2 to 127 do
begin
Pp1d := PosEx('/1/'+'\'+inttostr(D)+'\'+'{'+inttostr(TheBright)+'}'
+'|'+inttostr(TheContrast)+'|',LoadColorS,Pp2d);
Pp2d := PosEx(';',LoadColorS,Pp1d+1);
if (Pp1d>0) and (Pp2d>0) then
begin
s := copy(LoadColorS,Pp1d,Pp2d-Pp1d);
Pp1e := PosEx(',',s,1);
Pp2e := PosEx(',',s,Pp1e+1);
LastPart1 := 0; // Номер последней части массива
repeat
if (Pp1e>0) and (Pp2e>0) then
begin
Pp1f := PosEx('[',s,Pp1e);
Pp2f := PosEx(']',s,Pp1f+1);
if (Pp1f>0) and (Pp2f>0) then
begin
n5 := strtointdef(copy(s,Pp1f+1,Pp2f-Pp1f-1),-1); // Xmain
if n5>-1 then
begin
Pp1g := PosEx('(',s,Pp2f+1);
Pp2g := PosEx(')',s,Pp1g+1);
if (Pp1g>0) and (Pp2g>0) then
begin
n6 := strtointdef(copy(s,Pp1g+1,Pp2g-Pp1g-1),-1); // Номер названия цвета
if n6>-1 then
begin
Pp1h := PosEx('_',s,Pp2g+1);
Pp2h := PosEx('_',s,Pp1h+1);
if (Pp1h>0) and (Pp2h>0) then
begin
n7 := strtointdef(copy(s,Pp1h+1,Pp2h-Pp1h-1),-1); // Номер полного названия цвета
with ColorProperty[NumberLine,LastPart1] do
begin
Num := n5; // Xmain
Name := n6; // Номер названия цвета
FullName := n7; // Номер полного названия цвета
end;
LastPart1 := LastPart1+1; // Номер последней части массива
end;
end;
end;
end;
end;
end;
Pp1e := Pp2e;
Pp2e := PosEx(',',s,Pp1e+1);
until (Pp1e=0) or (Pp2e=0);
// Если остались незаполненные части массива
l := length(ColorProperty[NumberLine]); // Длина последней части массива
if LastPart1<=l-1 then
for i := LastPart1 to l-1 do
with ColorProperty[NumberLine,i] do
begin
Num := -1; // Xmain
Name := -1; // Номер названия цвета
FullName := -1; // Номер полного названия цвета
end;
end;
NumberLine := NumberLine+1; // Номер ячейки в массиве
end;
end;
Pp2d := Pp2e;
for TheBright := 0 to 255 do
begin
Pp1d := PosEx('/0/'+'\1\'+'{'+inttostr(TheBright)+'}'+'|0|',LoadColorS,Pp2d);
Pp2d := PosEx(';',LoadColorS,Pp1d+1);
if (Pp1d>0) and (Pp2d>0) then
begin
s := copy(LoadColorS,Pp1d,Pp2d-Pp1d);
Pp1e := PosEx(',',s,1);
Pp2e := PosEx(',',s,Pp1e+1);
LastPart1 := 0; // Номер последней части массива
repeat
if (Pp1e>0) and (Pp2e>0) then
begin
Pp1f := PosEx('[',s,Pp1e);
Pp2f := PosEx(']',s,Pp1f+1);
if (Pp1f>0) and (Pp2f>0) then
begin
n5 := strtointdef(copy(s,Pp1f+1,Pp2f-Pp1f-1),-1); // Xmain
if n5>-1 then
begin
Pp1g := PosEx('(',s,Pp2f+1);
Pp2g := PosEx(')',s,Pp1g+1);
if (Pp1g>0) and (Pp2g>0) then
begin
n6 := strtointdef(copy(s,Pp1g+1,Pp2g-Pp1g-1),-1); // Номер названия цвета
if n6>-1 then
begin
Pp1h := PosEx('_',s,Pp2g+1);
Pp2h := PosEx('_',s,Pp1h+1);
if (Pp1h>0) and (Pp2h>0) then
begin
n7 := strtointdef(copy(s,Pp1h+1,Pp2h-Pp1h-1),-1); // Номер полного названия цвета
with ColorProperty[NumberLine,LastPart1] do
begin
Num := n5; // Xmain
Name := n6; // Номер названия цвета
FullName := n7; // Номер полного названия цвета
end;
LastPart1 := LastPart1+1; // Номер последней части массива
end;
end;
end;
end;
end;
end;
Pp1e := Pp2e;
Pp2e := PosEx(',',s,Pp1e+1);
until (Pp1e=0) or (Pp2e=0);
// Если остались незаполненные части массива
l := length(ColorProperty[NumberLine]); // Длина последней части массива
if LastPart1<=l-1 then
for i := LastPart1 to l-1 do
with ColorProperty[NumberLine,i] do
begin
Num := -1; // Xmain
Name := -1; // Номер названия цвета
FullName := -1; // Номер полного названия цвета
end;
end;
NumberLine := NumberLine+1; // Номер ячейки в массиве
end;
end;
end
else showmessage('Не найден файл "AllBrights.txt"');
end;
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.
function AboutColor(R,G,B:byte) : ColorProperties; // Свойства цвета через "R,G,B"
var
RGBmax,RGBmin,RGBmid,
Rm,Gm,Bm,BGW,D,Light,E,
Q,Z,Y1,Qp,LR,Xc,Xmain,
Zmax:extended;
n,n2,k,k2,l2,m,m2,Lastk,Lastk2,
NumOfName,NumOfBright,i,j,l,Count1,
a1,b1,c1:integer;
NameByNum,BrightNameByNum,
s,ss:string;
begin
// ОСНОВНЫЕ ХАРАКТЕРИСТИКИ ЦВЕТА //////////////////////////////////////////////
// Найти максимальное, минимальное и среднее значение из заданных R,G,B
RGBmax:=(((((R+G)/2)+(abs(R-G)/2))+B)/2)+(abs((((R+G)/2)+(abs(R-G)/2))-B)/2);
RGBmin:=(((((R+G)/2)-(abs(R-G)/2))+B)/2)-(abs((((R+G)/2)-(abs(R-G)/2))-B)/2);
RGBmid:=(R+G+B)-(RGBmax+RGBmin);
// Обозначить максимальное значение в виде «2», среднее «1» и минимальное «0»
Rm:=abs((Trunc((R+1)/(RGBmax+1))*3)+Trunc((RGBmin+1)/(R+1))-1);
Gm:=abs((Trunc((G+1)/(RGBmax+1))*3)+Trunc((RGBmin+1)/(G+1))-1);
Bm:=abs((Trunc((B+1)/(RGBmax+1))*3)+Trunc((RGBmin+1)/(B+1))-1);
BGW:=1-Trunc((Rm+Gm+Bm)/9); // Если (R=G=B), то BGW=0, иначе BGW=1
D:=((RGBmax-RGBmin+1)/2)-Trunc((RGBmax-RGBmin+1)/2); // Если нечетн. яркость. или (R=G=B), то D=0.5 , иначе D=0
Light:=((253+((RGBmax-127)-(127-RGBmin)))/2)-D+(1-BGW); // Яркость выбранного цвета
E := Ceil((RGBmid-Light)/129); // Если выбран четный (2,4,6) треугольник, то E=1, иначе (1,3,5) E=0
// Номер треугольника
Q := ((1-E)*(Trunc(Rm/2)+Trunc(Gm/2)*3+Trunc(Bm/2)*5)+E*((1-Ceil(Bm/2))*2+(1-Ceil(Rm/2))*4+(1-Ceil(Gm/2))*6))*BGW;
//Zmax := Floor(abs(127-abs((127-Light)-D)))*BGW; // Максимальное количество рядов на яркости "Light"
Z := (127-((RGBmax-Light)-1-(D*2)))*BGW; // Контрастность (Номер ряда с цветом)
Y1 := (((127-Z)*2)+(D*4)*E)*BGW; // Количество ячеек в ряду "Z"
Qp := Q-Floor(Q/4)*3; // Приравниваем 6 треугольников к виду 1,2,3 (1-4,2-5,3-6)
// Если выделена левая сторона треугольника, или центр, LR=0. Если правая, LR=1
LR := (1-abs(Bm-1))*Trunc((Qp-1)/2)+ // Если Bm = RGBmid, и Qp = 3(6), то LR=1
(1-abs(Rm-1))*(1-abs(Qp-2))+ // Если Rm = RGBmid, и Qp = 2(5), то LR=1
(1-abs(Gm-1))*(1-Ceil((Qp-1)/2)); // Если Gm = RGBmid, и Qp = 1(4), то LR=1
Xc := abs((Light-RGBmin)*(1-LR*2)-abs(RGBmid-RGBmin*(1-E)-RGBmax*E)+(D*2)*E*(1-LR*2)); // Порядковый № ячейки
Xmain := ((127-Y1/2)+Xc+(Q-1)*255)*BGW;// // Оттенок (Координата по оси X, на общей сетке координат)
// НОМЕР ЯЧЕЙКИ В МАССИВЕ //////////////////////////////////////////////////////
a1 := floor(Light /128); // 1 - Если "TheBright">127
b1 := trunc(127-abs(127-Light)+1); // Количество повторений яркости
c1 := trunc((abs((16385-(b1-1))*a1-(1+b1*(b1-1)/2))
+((D*2)*(16384-floor(Light/127)-a1*(Light-127)))
+((b1-1)-(127-Z)))*BGW+(32641+Light)*(1-BGW)-1); // Номер ячейки в массиве
// НОМЕР НАЗВАНИЯ ЦВЕТА ///////////////////////////////////////////////////////
l := length(ColorProperty[c1]); // Длина последней части массива
Count1 := -1; // Номер последней части массива
for i := 0 to l-1 do
with ColorProperty[c1,i] do
begin
if (i+1<=l-1) and (Num>-1) then
begin
// Если выбранный цвет попадает в заданный диапазон
if (Xmain >= Num) and
(Xmain < ColorProperty[c1,i+1].Num)
then
begin
Count1 := i;
break;
end;
end
else
begin
for j := i downto 0 do
with ColorProperty[c1,j] do
if Num > -1 then
begin
Count1 := j;
break;
end;
end;
end;
// НАЗВАНИЕ ЦВЕТА ПО НОМЕРУ ///////////////////////////////////////////////////
if Count1 > -1 then
with ColorProperty[c1,Count1] do
begin
Result.Num := Name; // Номер цвета
Result.FullNum := FullName; // Номер полного имени цвета
Result.Name := NameOfColor[Name,0]; // Имя цвета
Result.FullName := NameOfColor[Name,FullName+1]; // Полное имя цвета (по яркости)
end;
Result.BGW := trunc(BGW); // Если "R=G=B" то BGW=0, иначе BGW=1
Result.Bright := Light+D*BGW; // Яркость
Result.Shade := trunc(Xmain); // Оттенок (Цвет)
Result.Contrast := trunc(Z); // Контрастность
Result.Triangle := trunc(Q); // Номер треугольника
Result.CountCell := trunc(Y1); // Количество ячеек, в треугольнике, в ряду "Contrast"
Result.Cell := trunc(Xc); // Номер ячейки, в треугольнике, в ряду "Contrast"
// Result.CountRow := trunc(Zmax); // Количество рядов, на яркости "Bright"
end;
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.
procedure TForm3.FormCreate(Sender: TObject); // Загрузить свойства цвета из текстового документа
begin
ColorInMass;
end;
procedure TForm3.Button1Click(Sender: TObject); // Свойства цвета через "R,G,B"
var
R,G,B:byte;
begin
R := 255; G := 0; B := 0;
with AboutColor(R,G,B) do
begin
showmessage('R '+inttostr(R)+' G '+inttostr(G)+' B '+inttostr(B)
+#13#10+'Имя цвета: '+Name
+#13#10+'Полное имя: '+FullName
+#13#10+'Номер цвета: '+inttostr(Num)
+#13#10+'Номер полного имени цвета: '+inttostr(FullNum)
+#13#10+'Яркость: '+floattostr(Bright)
+#13#10+'Оттенок: '+inttostr(Shade)
+#13#10+'Контрастность: '+inttostr(Contrast)
+#13#10+'Номер треугольника: '+inttostr(Triangle)
+#13#10+'Количество ячеек, в треугольнике, в ряду "Контрастность": '
+inttostr(CountCell)
+#13#10+'Номер ячейки, в треугольнике, в ряду "Контрастность": '
+inttostr(Cell) );
end;
end;
end.
|
