Распознавание образов

type
  TMas16x16 = array [0..15] of array [0..15] of byte;  // приведенная матрица (шаблон) распознавания 16x16
 
var
  MasSimple16 : array of TMas16x16;                    // массив шаблонов
 
 
//========== процедура генерации приведенной матрицы ===========================
  
function Create_16x16(Img : TBitmap) : TMas16x16;
type
  MasX = PByteArray;
var
  MasY : array of MasX;                             // битмап в памяти как массив (Y x X)
  j, i : integer;
  xLeft, xRight, yTop, yBottom : integer;           // абс. коорд. образа
  ki, kj : integer;
  nSymbol : integer;                                // кол-во значимых пикселей
  Percent : double;                                 // процент заполнения
  XY : array [0..16] of record
  x, y : integer end;  // относительные координаты анализируемых ячеек
  W, H : integer;                                   // ширина и высота образа
 
begin
  SetLength(MasY, Img.Height);                      // выделяем память под битмап
  for j := 0 to Img.Height - 1 do                   // получаем отображение битмапа в массиве
    MasY[j] := Img.ScanLine[j];                     // MasY[y - координата][x - координата] = знач. пикселя (x,y)
 
  //-------- получение координат границ образа ---------------------------------
  // здесь и далее предполагается что значение MasY[y][x] = 0 соответствует черному цвету пикселя
 
 
  xLeft := -1;                                      // инициализация
  xRight := -1;
  yTop := -1;
  yBottom := -1;
 
  for j := 0 to Img.Height - 1 do                   // Top
  begin
    for i := 0 to Img.Width - 1 do
      if MasY[j][i] = 0 then
      begin yTop := j; break; end;
    if yTop = j then break;
  end;
 
  for j := Img.Height - 1 downto 0 do               // Bottom
  begin
    for i := 0 to Img.Width - 1 do
      if MasY[j][i] = 0 then
      begin yBottom := j + 1; break; end;
    if yBottom = j + 1 then break;
  end;
 
  for i := 0 to Img.Width - 1 do                    // Left
  begin
    for j := 0 to Img.Height - 1 do
      if MasY[j][i] = 0 then begin xLeft := i; break; end;
    if xLeft = i then break;
  end;
 
  for i := Img.Width - 1 downto 0 do                // Right
  begin
    for j := 0 to Img.Height - 1 do
      if MasY[j][i] = 0 then begin xRight := i + 1; break; end;
    if xRight = i + 1 then break;
  end;
 
  //----------------------------------------------------------------------------
 
  if ((yBottom - yTop)*(xRight - xLeft)) = 0 then   // если ничего не нарисовано
  begin
    exit;
  end;
 
  //----------------------------------------------------------------------------
  // получаем процент заполнения как отношение кол-ва значимых пикселей к общему
  // кол-ву пикселей в границах образа
  // Percent будет необходим при анализе каждой ячейки в разбитом на 16х16 образе
  nSymbol := 0;
  for j := yTop to yBottom do
  for i := xLeft to xRight do
    if MasY[j][i] = 0 then inc(nSymbol);
  Percent := nSymbol / ((yBottom - yTop)*(xRight - xLeft));
  Percent := 0.3*Percent;     // коэф-т влияет на формирование матрицы 16х16
                               // > 1 - учитывается меньше значимых пикселей
                               // < 1 - учитывается больше значимых пикселей
  //----------------------------------------------------------------------------
  //----------------------------------------------------------------------------
  // разбиваем прямоугольник образа на 16 равных частей путем деления сторон на 2
  // и получаем относительные координаты каждой ячейки
 
  W := xRight - xLeft;;
  XY[0].x  := 0;
  XY[16].x := W;
  XY[8].x  :=   XY[16].x div 2;
  XY[4].x  :=   XY[8].x div 2;
  XY[2].x  :=   XY[4].x div 2;
  XY[1].x  :=   XY[2].x div 2;
  XY[3].x  :=  (XY[4].x + XY[2].x) div 2;
  XY[6].x  :=  (XY[8].x + XY[4].x) div 2;
  XY[5].x  :=  (XY[6].x + XY[4].x) div 2;
  XY[7].x  :=  (XY[8].x + XY[6].x) div 2;
  XY[12].x :=  (XY[16].x + XY[8].x) div 2;
  XY[10].x :=  (XY[12].x + XY[8].x) div 2;
  XY[14].x :=  (XY[16].x + XY[12].x) div 2;
  XY[9].x  :=  (XY[10].x + XY[8].x) div 2;
  XY[11].x :=  (XY[12].x + XY[10].x) div 2;
  XY[13].x :=  (XY[14].x + XY[12].x) div 2;
  XY[15].x :=  (XY[16].x + XY[14].x) div 2;
  H := yBottom - yTop;
  XY[0].y  := 0;
  XY[16].y := H;
  XY[8].y  :=   XY[16].y div 2;
  XY[4].y  :=   XY[8].y div 2;
  XY[2].y  :=   XY[4].y div 2;
  XY[1].y  :=   XY[2].y div 2;
  XY[3].y  :=  (XY[4].y + XY[2].y) div 2;
  XY[6].y  :=  (XY[8].y + XY[4].y) div 2;
  XY[5].y  :=  (XY[6].y + XY[4].y) div 2;
  XY[7].y  :=  (XY[8].y + XY[6].y) div 2;
  XY[12].y :=  (XY[16].y + XY[8].y) div 2;
  XY[10].y :=  (XY[12].y + XY[8].y) div 2;
  XY[14].y :=  (XY[16].y + XY[12].y) div 2;
  XY[9].y  :=  (XY[10].y + XY[8].y) div 2;
  XY[11].y :=  (XY[12].y + XY[10].y) div 2;
  XY[13].y :=  (XY[14].y + XY[12].y) div 2;
  XY[15].y :=  (XY[16].y + XY[14].y) div 2;
  //----------------------------------------------------------------------------
  //----------------------------------------------------------------------------
  // анализируем каждую полученную ячейку в разбитом прямоугольнике образа
  // и создаем приведенную матрицу 16x16
 
  for kj := 0 to 15 do
  for ki := 0 to 15 do
  begin
    nSymbol := 0;
    for j := yTop + XY[kj].y to yTop + XY[kj+1].y do    // пробегаемся по ячейкам уже
    for i := xLeft + XY[ki].x to xLeft + XY[ki+1].x do  // в абсолютных координатах
      if MasY[j][i] = 0 then inc(nSymbol);              // считаем кол-во значимых пикселей (=0 -> черный цвет)
    // если отношение кол-ва знач. пикселей к общему кол-ву в ящейке > характерного процента заполнения то = 1 иначе = 0
    if nSymbol / MAX(1, ((XY[ki+1].x - XY[ki].x) * (XY[kj+1].y - XY[kj].y))) > Percent
      then Result[kj][ki] := 1 else Result[kj][ki] := 0; // результат - приведенная матрица 16х16
  end;
end;