[alexnov]

Доброго времени суток!
Задача состоит в следующем: из загруженной картинки (для начала BMP) необходимо получить количество пикселов каждого цвета, которые содержит картинка. Задача простая, но как решить не знаю, с графикой дела не имел! Поможите плиз! ))

[The Shadow]

самый простой способ - перебор, может есть и другие

Код:

function ColorCount(const Pic: TImage; const Color: TColor): Integer;
var
  i, j: Integer;
begin
  Result:=0;
  for i:=1 to Pic.Width do
  for j:=1 to Pic.Height do
  if Pic.Canvas.Pixels[i][j] = Color then
  Inc(Result);
end;

зы. не проверял

[alexnov]

неее, нужно посчитать сколько всего цветов в картинке и вывести какие это конкретно цвета! Как посчитать сколько цветов я нашел:

Код:

function HowManyColors(Bitmap: TBitmap): Integer;
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;

var
  i: Byte;
  x, y: Integer;
  Dest: pRGB;
  RGBArray: array[0..255, 0..255] of array of Byte;
begin
  Bitmap.PixelFormat := pf24Bit;
  Result := 0;
  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with Dest^ do
        if RGBArray[r, g] <> nil then
          for i := 0 to High(RGBArray[r, g]) do
          begin
            //если такой цвет уже есть, то выходим из цыкла
            if RGBArray[r, g][i] = b then
              Break;
            //если это последний круг цикла, то такого цвета нет
            if i = High(RGBArray[r, g]) then
            begin
              Inc(Result); //прибавляем один цвет
              SetLength(RGBArray[r, g], Length(RGBArray[r, g]) + 1);
              RGBArray[r, g][High(RGBArray[r, g])] := b;
            end;
          end
        else
        begin
          Inc(Result);
          SetLength(RGBArray[r, g], 1);
          RGBArray[r, g][0] := b;
        end;
      Inc(Dest);
    end;
  end;
end;

Пример использования: 
procedure TForm1.MMHowManyColorsClick(Sender: TObject);
var
  str: string;
begin
  Screen.Cursor := crHourGlass;
  try
    str := Format('Изображение содержит %d цветов.', [HowManyColors(FBitmap)]);
  finally
    Screen.Cursor := crDefault;
  end;
  Application.MessageBox(PChar(str), PChar(Application.Title), MB_OK);
end;

А вот как получить эти цета??? То есть например если цветов на картинке встречается 3 штуки, то вывести:
Цвет 1 - код цвета;
Цвет 2 - код цвета;
Цвет 3 - код цвета;

[The Shadow]

что нибудь такое (неоптимизированно, скорее всего есть варианты вроде того, что вы привели в качестве примера для вычисления числа цветов изображения )

Код:

var
  i, j: Cardinal;
  Colors: array [$FF000000..$FFFFFFFF] of integer;
begin
  for i:=1 to Image.Picture.Width do
  for j:=1 to Image.Picture.Height do
  Inc(Colors[Image.Canvas.Pixels[i, j]]);
  for i:=$FF000000 to $FFFFFFFF do
  if Colors[Image.Canvas.Pixels[i, j]] > 0 then
  Memo1.Lines.Add(IntToStr(i) + ' ' + IntToStr(Colors[i]) + ' раз');

[alexnov]

Переполнение стека пишет! А как приведенный мною код поправить как мне надо??? Я чето не могу понять что там делается...

[The Shadow]

со ScanLine'ми не работал, вроде в факе были примеры какие то

[Asinkrit]

Сообщение от The Shadow

Colors: array [$FF000000..$FFFFFFFF] of integer;

[/code]

)))

при отработке алгоритма, потребуется создание массива длинною 16 777 216 элементов, и потребуется выделения памяти более чем на 67 мегабайт)))
Лучше создать пустой массив и добавлять в него найденные цвета, в данном случае максимальное кол-во цветов не превысит Height * Width.

Обращение через Canvas.Pixels[,] - оооочень медленное, в данном случае ScanLine работает в сотню! раз быстрее)

[Asinkrit]

Сообщение от alexnov

Доброго времени суток!
Задача состоит в следующем: из загруженной картинки (для начала BMP) необходимо получить количество пикселов каждого цвета, которые содержит картинка. Задача простая, но как решить не знаю, с графикой дела не имел! Поможите плиз! ))

Очень понравилась задача, решил попробовать свои силы)

Идея проста, но сложно реализована для повышения производительности.

желательно на время работы функции блокировать вызывающий ее обработчик.

Код:

function TForm1.HowManyColors(const Bitmap: TBitmap; const Memo:TMemo): Integer;
type //это лучше определять в начале модуля

  TRGB = record
    B, G, R: Byte;
  end;

  ARGB = array[0..1] of TRGB; 
  PARGB = ^ARGB;

const
  CArrayLengthInc = 10000;


type //а это в функции
  TColorCnt = record
    FColor:TColor;       //Одна ячейка массива содержит цвет
    FCount:Integer;      //и его кол-во
  end;

var
  x, y, i, l, tmp:integer;
  p: PARGB;

  Colors: Array of TColorCnt;  //Массив всех найденых цветов

begin
  //Подготовимся)
  l:=CArrayLengthInc;
  SetLength(Colors,l); //для начала создадим массив на 10000 элементов
  //Функция SetLength будет тормозить весь процесс, лучше 
  //ее вызывать поменьше)
  with Colors[0] do
    begin
    FColor:=0; //один цвет (черный) определим заранее
    FCount:=0;
    end;
  Result:=1; //Result - кол-во найденных элементов)
  with Bitmap do
    for y := 0 to Height - 1 do //перебираем строки массива(линии картинки)
      begin
      p := ScanLine[y];
      for x := 0 to Width - 1 do//перебираем элементы массива (пиксели)
         begin
         with p[x] do  tmp:=(r*g*b);  //берем цвет пикселя
         for i:=0 to Result - 1 do  //перебираем цвета
             if Colors[i].FColor = tmp then // если у нас есть такой цвет
               begin
               Inc(Colors[i].FCount);  //то увеличиваем у него счетчик
               Break;    //и покидаем цикл перебора цветов
               end;
         if Length(Colors)=Result then //иначе проверяем не достигнут ли 
           begin                              //конец массива
           Inc(l,CArrayLengthInc);  //если да, то увеличиваем его еще
           SetLength(Colors, l);     //на 10000 элементов
           end;
         with Colors[Result] do //и сохраняем новый цвет
           begin
           FColor:=tmp;
           FCount:=1;
           end;
         Inc(Result);
         //результаты можно вставить вывод результата статуса
         // выполнения данной функции, к примеру если ты хочешь
         //показывать состояние выполнения)
         Application.ProcessMessages; //Это что бы приложение не висло
         end;
      end;
  
  //Вот вывести все элементы - безумие, так как цветов может быть 
  //очень большое кол-во и займет это чуть меньше времени, чем 
  //первая чать функции, я бы отказался от этой затеи)
  
  with Memo.Lines do
    begin                                   
    BeginUpdate;
    Clear;
    if (Result-Ord(Colors[0].FCount=0))>0 then
      for i:=0+Ord(Colors[0].FCount=0) to Result-1 do
        with Colors[i] do
          Add('Код цвета: '+IntToStr(FColor)+' - '+IntToStr(FCount)+' раз');
    EndUpdate;
    end;
  //пора покинуть функцию, но вдруг у картинки не было черного цвета, 
  if Colors[0].FCount = 0 then Dec(Result); // не будем врать)
  SetLength(Colors,0);  //и освободим массив
end;


procedure TForm1.MMHowManyColorsClick(Sender: TObject);
begin
  ShowMessage('Изображение содержит '+Inttostr(
    HowManyColors(Image1.Picture.Bitmap,Memo1))+' цветов');
end;

При больших и многокрасочных изображениях, процесс выполнения будет длительным (в этом случае, как минимум стоит удалить вывод всех элементов, блок with Memo Lines do begin .. end)!

Удачи)

[alexnov]

А как решить вопрос с памятью? При загрузке файла размером больше 500 мб, выскакивает сообщение о нехватке памяти!

[Aristarh Dark]

Да не нужно загружать картинку вообще, работай напрямую с файлом.

[alexnov]

Сообщение от Aristarh Dark

Да не нужно загружать картинку вообще, работай напрямую с файлом.

А что есть разница???? Проверь плиз у себя будет этот код работать с файлом в 600 мб????!!!

[Aristarh Dark]

Можешь мне не верить, но будет работать вполне приемлимо
Вот только писать код только ради того чтобы проверить его на скорость - мне как-то лениво.

[alexnov]

Тогда вопрос что значит работать с файлом напрямую? Соответствует ли этому принципу последний код, написанный Asinkrit'ом???

[AleD]

Сообщение от alexnov

Тогда вопрос что значит работать с файлом напрямую? Соответствует ли этому принципу последний код, написанный Asinkrit'ом???

Asinkrit предварительно загружает битмап, если как говорится использовать битмап в 600мб это чистое насилование компа, точнее оперативки. Описание битмапа можно найти в модуле windows.pas, считывать по ~16384 пикселей и искать цвета.

[Aristarh Dark]

Сообщение от AleD

считывать по ~16384 пикселей и искать цвета

А еще лучше считывать по n строк картинки, тогда не нужно заморачиваться в рассчетах выравнивания.