Тема: Преобладающие цвета в изображении
Показать сообщение отдельно
  #7  
Старый 07.05.2013, 12:59
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
  
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
По умолчанию
Цитата:
Сообщение от AlexSku
Я же разбил задачу на кусочки. Вы хотите сказать, что на Delphi нельзя перевести RGB в Lab? Гистограмма это вообще элементарно, Ватсон: количество элементов в каждом интервале. и т.д.

Я хочу сказать, что для меня это дремучий лес не в плане знаний предмета, а в плане реализации... И с гистограммой проблем нет, нужно тока научиться их сравнивать, а вообще задача, как я уже говорил, ну сейчас уточню, сводится к поиску объекта определенной формы на изображении, т.е. просто есть он там или нет (и сколько раз встречается), при том само изображение может быть и черно-белым и зашумленным, а объект на нем может быть в другом ракурсе, повернут, сжат, удлинен, частично обрезан и т.п., т.е. это усложняет анализ, пытался обучить нейросеть для этого, но найденный пример оказался непригоден для использования с новым РАД Студио, да и библиотек соответствующих не оказалось...

Найденный пример получения гистограммы:

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
// Histogram
 
const
  RedCanal = 0;
  GreenCanal = 1;
  BlueCanal = 2;
  GrayCanal = 3;
 
type
 
  TRGB24 = array [0 .. 2] of Byte;
  ARGB24 = array [0 .. 0] of TRGB24;
  PRGB24 = ^ARGB24;
 
  TTypeCanal = Byte;
 
  PHistogram = ^THistogram;
 
  THistogram = object
    m_Count: LongWord;
    m_MaxColor: Byte;
    m_Color: Array [0 .. 255] of LongWord;
 
    Procedure GetData(BitMap: TBitmap; rc: TRect; tcnl: TTypeCanal);
  end;
 
var
  Hist: THistogram;
  canal: TTypeCanal = RedCanal;
 
  // end Histogram
 
// Histogram
 
Procedure DrawHistogram(canvas: TCanvas; Histogram: PHistogram; rc: TRect);
var
  x, dx, dy: Real;
  y: LongWord;
  i: Byte;
begin
  canvas.Brush.Color := clBlack;
  canvas.Pen.Color := canvas.Brush.Color;
  canvas.Pen.Style := psSolid;
  canvas.Rectangle(rc);
  dx := (rc.Right - rc.Left) / 256.0;
  // dy := (rc.Bottom-rc.Top) / Histogram.m_Color[Histogram.m_MaxColor]; // ето правельно
  dy := (rc.Right - rc.Left) / (Histogram.m_Count) * 30;
  // но чтоби увидеть что гистограма одинаковая
  x := rc.Left;
  if (canal = GrayCanal) then
    canvas.Brush.Color := clGray
  else
    canvas.Brush.Color := $FF shl (canal * 8);
  canvas.Pen.Style := psClear;
  for i := 0 to 255 do
  begin
    y := rc.Bottom - Round(Histogram.m_Color[i] * dy);
    canvas.Rectangle(Round(x), y, Round(x + dx) + 1, rc.Bottom + 1);
    x := x + dx;
  end
end;
 
Procedure THistogram.GetData(BitMap: TBitmap; rc: TRect; tcnl: TTypeCanal);
var
  x0, y0, rWidth, rHeight: LongInt;
  i, x, y, Mx, My: LongInt;
  LinePict: PRGB24;
  Color: TRGB24;
  colorI: Byte;
begin
  x0 := rc.Left;
  y0 := rc.top;
  rWidth := rc.Right - rc.Left - 1;
  rHeight := rc.Bottom - rc.top - 1;
  m_Count := rWidth * rHeight;
  for i := 0 to 255 do
    m_Color[i] := 0;
  m_MaxColor := 0;
  Mx := x0 + rWidth;
  My := y0 + rHeight;
  for y := y0 to My do
  begin
    LinePict := BitMap.ScanLine[y];
    for x := x0 to Mx do
    begin
      Color := LinePict[x];
      if (canal = GrayCanal) then
        colorI := (Color[0] + Color[1] + Color[2]) div 3
      else
        colorI := Color[canal];
      Inc(m_Color[colorI]);
      if (m_Color[colorI] > m_Color[m_MaxColor]) then
        m_MaxColor := colorI;
    end;
  end;
end;
 
// Histogram End
 
//Using
 
procedure TForm1.Button12Click(Sender: TObject);
var
  BitMap: TBitmap;
  rc, rcDraw: TRect;
begin
  BitMap := TBitmap.Create;
  try
    BitMap.Width := Image1.Picture.Width;
    BitMap.Height := Image1.Picture.Height;
    BitMap.canvas.Draw(0, 0, Image1.Picture.Graphic);
    //
    BitMap.PixelFormat := pf24bit;
    rc := Rect(0, 0, BitMap.Width, BitMap.Height);
    Hist.GetData(BitMap, rc, canal);
    rcDraw := Rect(0, 0, Image3.Width, Image3.Height);
    DrawHistogram(Image3.canvas, @Hist, rcDraw);
  finally
    BitMap.Free;
  end;
end;
Ответить с цитированием