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