Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.03.2011, 19:33   #11
JTG
я получил эту роль
Старожил
 
Аватар для JTG
 
Регистрация: 25.05.2007
Сообщений: 3,694
По умолчанию

Перевести цвет в модель HSV и будет вам счастье

Код:
TsHSV = record 
        h: integer; //цвет
        s: real;    //насыщенность
        v: real     //яркость
end;

function Rgb2Hsv(C : TsColor) : TsHSV;
var
  Rt, Gt, Bt : real;
  H, S, V : real;
  d, max, min : integer;
begin
  C.A := 0;
  max := math.Max(math.Max(c.R, c.G), c.B);
  min := math.Min(math.Min(c.R, c.G), c.B);
  d := max - min;
  V := max;
  if (max <> 0) then S := d / max else S := 0;
  if S = 0 then begin
    Result.H := 0;
  end
  else begin
    rt := max - c.R * 60 / d;
    gt := max - c.G * 60 / d;
    bt := max - c.B * 60 / d;
    if c.R = max then H := bt - gt else if c.G = max then H := 120 + rt - bt else H := 240 + gt - rt;
    if H < 0 then H := H + 360;
    Result.H := Round(H);
  end;
  Result.S := S;
  Result.V := V / MaxByte;//0;
end;
пыщь

Последний раз редактировалось JTG; 30.03.2011 в 19:36.
JTG вне форума Ответить с цитированием
Старый 31.03.2011, 01:26   #12
Локи
 
Аватар для Локи
 
Регистрация: 08.03.2011
Сообщений: 9
По умолчанию

О, кажется, это то, что нужно.) Спасибо!

UPD: Все, программа работает с достаточной точностью ^_^

Последний раз редактировалось Локи; 31.03.2011 в 23:00.
Локи вне форума Ответить с цитированием
Старый 01.04.2011, 05:19   #13
Локи
 
Аватар для Локи
 
Регистрация: 08.03.2011
Сообщений: 9
По умолчанию

Вот что получилось в итоге. Точность дает приемлемую, впрочем это еще можно подкрутить (:

Код:
uses Math;

type
    TRGBColor = record //тип для хранения отдельных значений rgb-цвета
      R,
      G,
      B : Byte;
    end;

    {тип для хранения HSB-цвета. Hue, Saturation, Brightness — оттенок, насыщенность, яркость}
    THSBColor = record
      Hue, //оттенок
      Sat, //насыщенность
      Br : Double; // яркость
    end;

var
  red,yellow,green,blue,purple,orange,black,gray,picsize{размер изображения}: Integer;
  picpr{сколько пикселей в одном проценте площади изображения}: Double;

{Функция для конвертации rgb-цвета в hsb. Входное значение - запись с отдельными
значениями цветовых составляющих (RGB), выходное - эквивалент в HSV}
function RGBToHSB(rgb : TRGBColor) : THSBColor;
 var
    minRGB, maxRGB, delta : Double;
    h , s , b : Double ;
 begin
    H := 0.0 ;
    minRGB := Min(Min(rgb.R, rgb.G), rgb.B) ;
    maxRGB := Max(Max(rgb.R, rgb.G), rgb.B) ;
    delta := ( maxRGB - minRGB ) ;
    b := maxRGB ;
    if (maxRGB <> 0.0) then s := 255.0 * Delta / maxRGB
    else s := 0.0;
    if (s <> 0.0) then
    begin
      if rgb.R = maxRGB then h := (rgb.G - rgb.B) / Delta
      else
        if rgb.G = maxRGB then h := 2.0 + (rgb.B - rgb.R) / Delta
        else
          if rgb.B = maxRGB then h := 4.0 + (rgb.R - rgb.G) / Delta
    end
    else h := -1.0;
    h := h * 60 ;
    if h < 0.0 then h := h + 360.0;
    with result do
    begin
      Hue := h;
      Sat := s * 100 / 255;
      Br := b * 100 / 255;
    end;
 end;

procedure TForm1.btn2Click(Sender: TObject);
var
  i,j: Integer;
  c: TColor;
  col: TRGBColor; //объявляем переменную для хранения rgb-цвета
  colhsb: THSBColor; //аналогично для hsb-цвета
begin
  {обнуляем количества пикселей, считаем размер изображения и количество пикселей в одном его проценте}
  red:=0;
  yellow:=0;
  green:=0;
  blue:=0;
  purple:=0;
  orange:=0;
  black:=0;
  gray:=0;
  picsize:=img1.Picture.Width * img1.Picture.Height;
  picpr:=picsize/100;
  for i:=0 to img1.Picture.Width do
    for j:=0 to img1.Picture.Height do
      begin
        c:= img1.Canvas.Pixels[i, j]; // попиксельно считываем цвет
        col.R:=GetRValue(c); //берем красную составляющую
        col.G:=GetGValue(c); //берем зеленую составляющую
        col.B:=GetBValue(c); //берем синюю составляющую
        colhsb:=RGBToHSB(col); //преобразуем цвет
        {блок условий для красного, оранжевого, желтого, зеленого, синего и фиолетового цветов}
        if (colhsb.Sat>10) and (colhsb.Br>50) then
          begin
            if (colhsb.Hue<25) or ((colhsb.Hue>340) and (colhsb.Hue<360)) then
              Inc(red);
            if (colhsb.Hue>25) and (colhsb.Hue<44) then
              Inc(orange);
            if (colhsb.Hue>44) and (colhsb.Hue<70) then
              Inc(yellow);
            if (colhsb.Hue>70) and (colhsb.Hue<140) then
              Inc(green);
            if (colhsb.Hue>140) and (colhsb.Hue<250) then
              Inc(blue);
            if (colhsb.Hue>250) and (colhsb.Hue<320) then
              Inc(purple);
          end;
        {условия для серого цвета, причем цвета с насыщенностью меньше 5 таковыми не считаются}
        if ((colhsb.Sat<10) and (colhsb.Sat>5)) and ((colhsb.Br>10) and (colhsb.Br<50)) then
          Inc(gray);
        {условия для черного цвета - яркость меньше 10}
        if (colhsb.Br<10) then
          Inc(black);
      end;
end;
Огромное спасибо всем помогавшим ^^,
Локи вне форума Ответить с цитированием
Старый 01.04.2011, 11:35   #14
JTG
я получил эту роль
Старожил
 
Аватар для JTG
 
Регистрация: 25.05.2007
Сообщений: 3,694
По умолчанию

Ну так, на заметку: Canvas.Pixels; работает ужасно медленно, работу можно ускорить примерно в [ширина_картинки] раз, воспользовавшись свойством scanline
пыщь
JTG вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ABC анализ aliya_n_g Microsoft Office Excel 7 14.01.2011 08:48
выпуклый анализ Жанна__90 Помощь студентам 2 12.01.2011 22:59
АВС-анализ. abdumanon Microsoft Office Excel 8 14.09.2010 08:32
Сортировка+Анализ женя2010 Microsoft Office Excel 2 23.04.2010 12:06
Попиксельный доступ к TJPEGImage Serge_Bliznykov Общие вопросы Delphi 4 29.09.2009 22:57