[Vayrus]

Приветствую, необходима помощь в перечислении уникальных цветов в изображении, подсчет количества пикселей определенных цветов и выражение в % соотношении 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;

[M.A.D.M.A.N.]

Я бы так сделал:

Код:

var
  colorCount: array[TColor] of integer;
...
  for x...
    for y...
      inc(colorCount[bitmap.canvas.pixels[x, y]]);

Правда едрить сколько памяти оно сожрет.

[Vayrus]

Сообщение от M.A.D.M.A.N.

Я бы так сделал:

Код:

var
  colorCount: array[TColor] of integer;
...
  for x...
    for y...
      inc(colorCount[bitmap.canvas.pixels[x, y]]);

Правда едрить сколько памяти оно сожрет.

Памяти у меня много)) так что пока без оптимизации можно обойтись, главное, чтобы работало. А вообще, итоговый результат состоит в том, чтобы получить соотношение "цвета" кожи человека на изображении к другим цветам или количество пикселей "коричневого цвета" (с цветом кожи - это диапозон оттенков) к остальной сумме пикселей, вроде как то так

[AlexSku]

Есть другой подход (реализация, правда, на MatLab'е):
what-color-is-green
two-dimensional-histograms
freehand-segmentation-in-the-a-b-plane
more-on-segmenting-in-a-b-space

Сначала пространство RGB перевести в Lab. Яркость L не нужна. По ab строим двумерные гистограммы. Автор (Steve Eddins) приводит алгоритмы ручного и автоматического распознавания зелёных шариков.

[Vayrus]

Спасибо конечно, но реализаций на Матлабе и ПХП полно, а вот на Дельфине нет(

[AlexSku]

Я же разбил задачу на кусочки. Вы хотите сказать, что на Delphi нельзя перевести RGB в Lab? Гистограмма это вообще элементарно, Ватсон: количество элементов в каждом интервале. и т.д.