Приветствую, необходима помощь в перечислении уникальных цветов в изображении, подсчет количества пикселей определенных цветов и выражение в % соотношении 15 превалирующих... С подсчетом вроде как проблем нет, но решил объединить с подсчетом пикселей, в итоге получилось следующее, но выкидывает ошибку, сильно не вдавался, но, видимо сказывается мое полное нубство в массивах, и вообще по работе с пикселами:
Код:
procedure TForm1.Button9Click(Sender: TObject);
type
TColorInfo = record
Color: TColor;
count: integer;
end;
var
i: integer;
col: TColor;
//
multiArray: Array [0 .. 1000000] of TColorInfo;
procedure AddValue(aCol: TColor);
var
i: integer;
curr: TColorInfo;
begin
for i := Low(multiArray) to High(multiArray) do
begin
curr := multiArray[i];
if curr.Color = aCol then
begin
inc(curr.count);
BREAK;
end;
Application.ProcessMessages;
end;
//
multiArray[i + 1].Color := aCol;
multiArray[i + 1].count := 1;
end;
begin
for i := 0 to Image1.Height - 1 do
begin
for j := 0 to Image1.Width - 1 do
begin
col := Image1.Canvas.Pixels[j, i];
AddValue(col);
Application.ProcessMessages;
end;
Application.ProcessMessages;
end;
//
end;
До кучи чужой оптимизированный алго подсчета уникальных цветов:
Код:
procedure TForm1.Button1Click(Sender: TObject);
const
len = 2097152; // 2^24 div 8
var
x, y, adr, abyte, count: integer;
cbyte, bit: byte;
scan: pByteArray;
cnt: array of byte;
begin
SetLength(cnt, len);
count := 0;
FillChar(cnt[0], len, #0);
with TBitmap.Create do
begin
Assign(Image1.Picture.Graphic);
PixelFormat := pf24bit;
for y := 0 to Height - 1 do
begin
scan := ScanLine[y];
for x := 0 to Width - 1 do
begin
adr := scan[x * 3 + 0] shl 16 + scan[x * 3 + 1] shl 8 + scan[x * 3 + 2];
abyte := adr div 8;
bit := 1 shl (adr mod 8);
cbyte := cnt[abyte];
if cbyte and bit = 0 then
begin
cnt[abyte] := cbyte or bit;
inc(count);
end;
end;
end;
Free;
end;
Label1.caption := 'Количество цветов: ' + IntToStr(count);
end;