[Vayrus]

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

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

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

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

Код:

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