uglaz.pas

uglaz.pas

unit UGLAZ; {$mode objfpc}{$H+}{Абдулов Тимур Рифович 2015 год Email hostingurifa@gmail.com   .
;INFO
;Site    https://sites.google.com/site/timpascallib/
;Youtube https://www.youtube.com/watch?v=iqhYCRSG7Ug&list=PLlqeq-isbP97f-RrNJt6_ampCdYygWgVQ
;Google+ https://plus.google.com/u/0/+%D0%A2%D0%B8%D0%BC%D1%83%D1%80%D0%90%D0%B1%D0%B4%D1%83%D0%BB%D0%BE%D0%B2/posts
;GIST    https://gist.github.com/MisterTimur/2551507245f3453d03cd
;------------------------------------------------------------------------------}
interface
uses // Используемые модули
     Windows,Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
     ExtCtrls, Menus;
type { TFGLAZ } TFGLAZ = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    MenuItem1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    PopupMenu1: TPopupMenu;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MenuItem1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
var  FGLAZ: TFGLAZ;// переменая описывающая саму форму
implementation  {$R *.lfm} { TFGLAZ }
{%Region /fold} // ГРафический модуль UTiGr =================================
Const TiMaxKOlPix=4000000; // Максимальное количкество  пикселей


Type        TiCoo=record  // Структура для хранения координат
  X,Y:Longint;
end;
Function    Coo(iX,iY:Longint):TiCoo;
var rez:TiCoo;
begin
       rez.X:=iX;
       rez.Y:=iY;
       Coo:=Rez;
end;

Type        TiImg=Class  // Класс для работы с графикой
  BitMap:TBitMap;
  Mashtab:Longint;// Маштаб изображения
  info:TBitMapInfo;// Структура описывает формат изображение хранящиеся в масиве с пикселями
  Pixels:Array[0..TiMaxKOlPix] of LongWord;    // Сам масив с пикселями
  // ПРоцедуры для работы с пикселями ---------------------------------
  Function    RePiX(iX,iY:Longint):LongWord;   // Читает пиксель
  Function    RePiX(iCoo:TiCoo):LongWord;      // Читает пиксель
  Procedure   WrPix(iX,iY:Longint;iC:LongWord);// Записывает Пиксель
  Procedure   WrPix(iCoo:TiCoo;iC:LongWord);   // Записывает Пиксель
  // Процедуры для чтения и записи изображения ------------------------
  Procedure   SetSize(iWidth,iHeight,iMashtab:Longint);// Устанавливает размер матрицы изображения
  Procedure   ReCan(iC:TCanvas);// Читает изображение с канвы в масив пикселей
  Procedure   WrCan(iC:TCanvas);// Записывает изображение из масива с пикселями в канву
  Procedure   ReEcr(iX,iY:Longint);// Читает каритнку с экрана рзмером с Canvas по координатам iX iY в масив с пикселями
  Procedure   ReEcr;// читает каритнку с экрана целиком
  Function    Krai(iCoo:TiCoo):Boolean;// Возвражает False Если координаты точки на краю либо за его пределами
  Function    Predel(iCoo:TiCoo):Boolean;// Возвражает False Если координаты точки за его пределами
  Procedure   Clear;// Процедура очистки матрицйы изображения
  // ПРОцедуры для рисования ------------------------------------------
  procedure   Rect(ix1,iy1,ix2,iy2:Longint;iCol:LongWord);// Рисование прямоугольника не заполненого


  Constructor Create(iWidth,iHeight,iMashtab:Longint);
end;

Procedure   TiImg.SetSize(iWidth,iHeight,iMashtab:Longint);// Устанавливает размер матрицы изображения
Begin
MAshtab:=iMashtab;

BitMap.Height:=trunc(iHeight/MAshtab);   // Устанавливаем рамер промежуточного бит мапа для ввода и вывода изображения
BitMap.Width :=trunc(iWidth/MAshtab);
BitMap.PixelFormat:=pf24bit;// Формат Битмапа

// Структура описывает формат изображение хранящиеся в масиве с пикселями
with info.bmiHeader do begin  // Структура нужна для GetDIBits заполнения масива пикселями
biWidth:=BitMap.Width;        // Ширина
biHeight:=BitMap.Height;      // Высота
biSize:=SizeOf(TBITMAPINFOHEADER);// размепр информацилной структуры структуры
biCompression:=BI_RGB;      // Метод хранения пикселей
biBitCount:=32;             // Устанавлвиается сколько байт отводится при чтении ихображения в масив 4 байта
biPlanes:=1;                // Незнаю для чего
biSizeImage:=0;             // Не знаю зачем это нужно
end;

Mashtab:=iMashtab;
end;

Procedure   TiImg.ReCan(iC:TCanvas);// Читает изображение с канвы в масив пикселей
var
ORect,IREct:TRect;
begin
// Размер выходящего изображения
IRect.Left:=0;
IRect.Top:=0;
IRect.Right:=iC.Width;
IRect.Bottom:=iC.Height;

// Размер выводимого изображения котрый сформирован в процедуре ReCan ReEcr или какой либо другой функции записи изображения в масив пикселей
ORect.Left:=0;
ORect.Top:=0;
ORect.Right:=BitMap.Width;
ORect.Bottom:=BitMap.Height;

BitMap.Canvas.CopyRect(orect,iC,irect);// Ввод изображения из канвы в битмап с маштабированием
GetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS);// Записываем изображенеи из временого битмапа в Массив с пикселями
end;
Procedure   TiImg.WrCan(iC:TCanvas);// Записывает изображение из масива с пикселями в канву
var
ORect,IREct:TRect;
begin

// Размер выходящего изображения
ORect.Left:=0;
ORect.Top:=0;
ORect.Right:=iC.Width;
ORect.Bottom:=iC.Height;

// Размер выводимого изображения котрый сформирован в процедуре ReCan ReEcr или какой либо другой функции записи изображения в масив пикселей
IRect.Left:=0;
IRect.Top:=0;
IRect.Right:=BitMap.Width;
IRect.Bottom:=BitMap.Height;

// Перевод матрицы пикселей в изображение
SetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS);
iC.CopyRect(orect,BitMap.Canvas,irect);// Вывод изображения из битмапа с маштабирвоанием
end;
Procedure   TiImg.ReEcr(iX,iY:Longint); // Читает каритнку с экрана рзмером с Canvas по координатам iX iY в масив с пикселями
var
ScreenDC:HDC;
begin  // анологично функции ReEcr или ReCan только с указанимями кординат и размеров читаемого кусочка экрана

       // Читает картинку с экрана
       ScreenDC:=GetDC(0);
       BitBlt(BitMap.canvas.Handle,0,0,Info.bmiHeader.biWidth,Info.bmiHeader.biHeight,ScreenDC,iX,iY,SRCCOPY);
       ReleaseDC(0,ScreenDC);
       // Заносит в массив пикселей
       GetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS);

end;
Procedure   TiImg.ReEcr; // читает каритнку с экрана целиком
var
 BitMap2:TBitMAp;
 info2:TBitMapInfo;
 ScreenDC:HDC;
begin
       BitMap2:=TBitMap.Create;

       BitMap2.Height:=Screen.Height;
       BitMap2.Width:=Screen.Width;
       BitMap2.PixelFormat:=pf24bit;

       with info2.bmiHeader do begin
       biWidth:=Screen.Width;
       biHeight:=Screen.Height;
       biSize:=SizeOf(TBITMAPINFOHEADER);
       biCompression:=BI_RGB;
       biBitCount:=32;
       biPlanes:=1;
       biSizeImage:=0;
       end;
       ScreenDC:=GetDC(0);
       BitBlt(BitMap2.canvas.Handle,0,0,Screen.Width, Screen.Height,ScreenDC,0,0,SRCCOPY);
       ReleaseDC(0,ScreenDC);
       ReCan(BitMap2.canvas);
       BitMap2.free;

end;

Constructor TiImg.Create(iWidth,iHeight,iMashtab:Longint);// Нужно будет прописать деструктор освобождающий BitMap
begin
BitMap:=TBitMap.Create;
SetSize(iWidth,iHeight,iMashtab);
end;
Function    TiImg.RePiX(iX,iY:Longint):LongWord;// Читает цвет пикселя
begin
  RePiX:=Pixels[(BitMap.Width*iY)+iX];
end;
Function    TiImg.RePiX(iCoo:TiCoo):LongWord;// Читает цвет пикселя
begin
  RePiX:=RePiX(iCoo.X,iCoo.Y);
end;
Procedure   TiImg.WrPiX(iX,iY:Longint;iC:LongWord);// Записывает цвет пикселя
begin
  if ix>=0 then
  if iY>=0 then
  Pixels[(BitMap.Width*iY)+iX]:=iC
end;
Procedure   TiImg.WrPiX(iCoo:TiCoo;iC:LongWord);// Записывает цвет пикселя
begin
   WrPiX(iCoo.X,iCoo.Y,iC);
end;
Function    TiImg.Krai(iCoo:TiCoo):Boolean;// Возвражает False Если координаты точки на краю либо за его пределами
var
   Rez:Boolean;
begin
   rez:=True;
   if iCoo.X<=0 Then REz:=False else
   if iCoo.X>=info.bmiHeader.biWidth-1 Then REz:=False else
   if iCoo.Y<=0 Then REz:=False else
   if iCoo.Y>=info.bmiHeader.biHeight-1 Then REz:=False;
   Krai:=Rez;
end;
Function    TiImg.Predel(iCoo:TiCoo):Boolean;// Возвражает False Если координаты точки за его пределами
var
   Rez:Boolean;
begin
   rez:=True;
   if iCoo.X<0 Then REz:=False else
   if iCoo.X>info.bmiHeader.biWidth-1 Then REz:=False else
   if iCoo.Y<0 Then REz:=False else
   if iCoo.Y>info.bmiHeader.biHeight-1 Then REz:=False;
   Predel:=Rez;
end;
Procedure   TiImg.Clear;// Процедура очистки матрицйы изображения
var
   f:LongWord;
Begin
   for f:=0 to (info.bmiHeader.biHeight*info.bmiHeader.biWidth) do
    Pixels[f]:=0;
end;
procedure   TiImg.Rect(ix1,iy1,ix2,iy2:Longint;iCol:LongWord); // Рисование прямоугольника не заполненого
var
   f:Longint;
begin

   if iX2<iX1 then
              begin
              f:=iX1;
              iX1:=iX2;
              iX2:=f;
              end;

   if iY2<iY1 then
              begin
              f:=iY1;
              iY1:=iY2;
              iY2:=f;
              end;


   for f:=iX1 to iX2 do
   begin
   WrPix(f,iY1,iCol);
   WrPix(f,iY2,iCol);
   end;

   for f:=iY1 to iY2 do
   begin
   WrPix(iX1,f,iCol);
   WrPix(iX2,f,iCol);
   end;

end;

{%Endregion} // ====================================================================
{%Region /fold} // Сексия ПОле ==============================================
Type TPole=class (TiImg)
  Els:Array[0..TiMaxKOlPix] of Pointer;// Сам масив с Элментами
  Function    ReEle(iX,iY:LongWord):Pointer;// Возвращет элемент котрому принадлежит пиксель
  Function    ReEle(iCoo:TiCoo):Pointer;// Возвращет элемент котрому принадлежит пиксель
  Procedure   WrEle(iX,iY:LongWord;iP:Pointer);// Записывает элемент котрому принадлежит пиксель
  Procedure   WrEle(iCoo:TiCoo;iP:Pointer);// Записывает элемент котрому принадлежит пиксель
end;

Function    TPole.ReEle(iX,iY:LongWord):Pointer;// Возвращет элемент котрому принадлежит пиксель
begin
  ReEle:=Els[(BitMap.Width*iY)+iX];
end;
Function    TPole.ReEle(iCoo:TiCoo):Pointer;// Возвращет элемент котрому принадлежит пиксель
begin
  ReEle:=ReEle(iCoo.X,iCoo.Y);
end;
Procedure   TPole.WrEle(iX,iY:LongWord;iP:Pointer);// Записывает элемент котрому принадлежит пиксель
begin
  Els[(BitMap.Width*iY)+iX]:=iP
end;
Procedure   TPole.WrEle(iCoo:TiCoo;iP:Pointer);// Записывает элемент котрому принадлежит пиксель
begin
   WrEle(iCoo.X,iCoo.Y,iP);
end;


{%Endregion}
{%Region /fold} // Секция описания Элемента изображения =====================
Const TiMaxKOlEls=4096;
Type TiEle=Class
     X,Y,C :LongWord;  // Коодинаты элемента по X , Y и Цвет элемента
     MinX,MaxX:Longint;// Минимальная и минимальная координата элемнета  из которох состоит элемент
     MinY,MaxY:Longint;// Минимальная координата элемента из которох состоит элемент
     Hiri:Longint;     // Ширина Элемента изображения
     Viso:Longint;     // Высота Элемента изображения
     Kol:Longint;      // Количество элментов из котрых состояит Элемент
     Els:Array[1..TiMaxKOlEls] of TiEle; // Масив с элементами из котрых сосотит элемент
     OKr:TiEle;                          // Список соседствующих элементов
     Function   Add(iCoo:TiCoo;iC:LongWord):TiEle;// Добавляет Элемент размером с пиксель
     Procedure  Add(iEle:TiEle);// Добавляет Элемент в списк
     Function   Est(iEle:TiEle):Boolean;// Проверяет есть ли такой элемент в списке
     Function   Coo:TiCoo;// Возвращает координаты элемента
     Function   Coo(iNN:Byte):TiCoo;// Возвращает координаты элемента
     Function   Sel(sx1,sy1,sx2,sy2:Longint):Tiele;// Возвращет список элементов Помещающиеся в заданые приеделы
     Function   Vme(sx1,sy1,sx2,sy2:Longint):Boolean;// ПРоверяет находимться и помесчаеться  ли элемент в заданом квадрате
     Function   Cop:TiEle;// Возвращает копию элемента с всеми вложенеми элементами
     Procedure  Cle;// Процедура очистки элмента ;
     Procedure  Sdvig(iMinX,iMinY:Longint);// Сдвигает изображение к краю согластно самой левой координате
     destructor Destroy; override;
 end;


destructor TiEle.Destroy;
begin
  Cle;
  inherited;
end;


Function  TiEle.Est(iEle:TiEle):Boolean;// Проверяет есть ли такой элемент в списке
var
   f:Longint;
   Rez:Boolean;
begin
  Rez:=False;
  for f:=1 to kol do
  if iEle=Els[f] Then  Begin REz:=True;Break;end;
  Est:=Rez;
end;

Function  TiEle.Coo:TiCoo;// Возвращает координаты элемента
var
     Rez:TiCoo;
Begin
     Rez.X:=X;
     Rez.Y:=Y;
     Coo:=Rez;
end;
Function  TiEle.Coo(iNN:Byte):TiCoo;// Возвращет координату элмента элемнта в заданом напрвлении
var
rez:TiCoo;
begin
   REz.X:=X;// Поумалчанию просто возвращает координату элемента
   REz.Y:=Y;
 if iNN=1 Then begin REz.Y:=REz.Y-1                end else
 if iNN=2 Then begin REz.Y:=REz.Y-1;REz.X:=REz.X+1 end else
 if iNN=3 Then begin                REz.X:=REz.X+1 end else
 if iNN=4 Then begin REz.Y:=REz.Y+1;REz.X:=REz.X+1 end else
 if iNN=5 Then begin REz.Y:=REz.Y+1                end else
 if iNN=6 Then begin REz.Y:=REz.Y+1;REz.X:=REz.X-1 end else
 if iNN=7 Then begin                REz.X:=REz.X-1 end else
 if iNN=8 Then begin REz.Y:=REz.Y-1;REz.X:=REz.X-1 end ;
 Coo:=Rez;
end;
Function  TiEle.Add(iCoo:TiCoo;iC:Longword):TiEle;// Создает и Добавляет Элемент размером с пиксель
var
   Rez:TiEle;
begin
Rez:=Nil;
if Kol<TiMaxKOlEls then
  begin

   Rez:=TiEle.Create;

   Rez.X:=iCoo.X; // Устанвока координат элемента
   Rez.Y:=iCoo.Y;
   Rez.C:=iC;     // Устанвлитает цвет элемента

   Rez.MinX:=Icoo.X;
   Rez.MinY:=Icoo.Y;

   Rez.MAxX:=Icoo.X;
   Rez.MAxY:=Icoo.Y;

   Rez.Hiri:=0;
   Rez.Viso:=0;

   Rez.kol:=0;

   add(Rez);

  end;
Add:=Rez;
end;
Procedure TiEle.Add(iEle:TiEle);// Добавляет элемент в списко
Begin
if Not Est(iEle) Then
if Kol<TiMaxKOlElS Then
  begin
  Kol:=kol+1;
  if Kol=1 Then      // Если это первый добавляемый элемент из котрого сотстоит этот элменет
           begin

           X:=iEle.X;
           Y:=iEle.Y;

           MinX:=iEle.MinX;
           MinY:=iEle.MinY;

           MaxX:=iEle.MAxX;
           MAxY:=iEle.MAxY;

           Hiri:=iEle.Hiri;
           Viso:=iEle.Viso;

           end else
           begin  //  В противном случае идет просто корекция ширины и высоты элеменат согластно обавленому элементу
             if iEle.X<MinX Then MinX:=iEle.X;
             if iEle.Y<MinY Then MinY:=iEle.Y;
             if iEle.X>MaxX Then MAxX:=iEle.X;
             if iEle.Y>MAxY Then MAxY:=iEle.Y;
             Hiri:=MaxX-MinX;
             Viso:=MaxY-MinY;
           end;


  Els[kol]:=iEle;
  end;
end;

Function  TiEle.Cop:TiEle;// Возвращает копию элемента с всеми вложенеми элементами
var
   Rez:TiEle;
   f:Longint;
Begin
   Rez:=TiEle.Create;
   rez.X:=X;
   rez.Y:=Y;
   rez.C:=C;
   rez.MinX:=MinX;
   rez.MaxX:=MaxX;
   rez.MinY:=MinY;
   rez.MaxY:=MaxY;
   rez.Hiri:=Hiri;
   rez.Viso:=Viso;
   rez.Kol:=Kol;
   for f:=1 to KOl do
   Rez.Els[f]:=Els[f].Cop;
Cop:=Rez;
end;
Function  TiEle.Vme(sx1,sy1,sx2,sy2:Longint):Boolean;// ПРоверяет находимться и помесчаеться  ли элемент в заданом квадрате
var
   Rez:Boolean;
   V:Longint;
begin
REz:=True;

   if SX1>SX2 Then     // Корректировака области выделения что бы SX1 всегда был меньше SX2
              begin
              V:=SX1;
              SX1:=SX2;
              SX2:=V;
              end;

   if SY1>SY2 Then     // Корректировака области выделения что бы SY1 всегда был меньше SY2
              begin
              V:=SY1;
              SY1:=SY2;
              SY2:=V;
              end;

   if MinX<Sx1 Then Rez:=False else
   if MaxX>Sx2 Then Rez:=False else
   if MinY<SY1 Then Rez:=False else
   if MaxY>SY2 Then Rez:=False;
Vme:=Rez;
end;
Function  TiEle.Sel(sx1,sy1,sx2,sy2:Longint):Tiele;// Возвращет список элементов
var
 REz:Tiele;
 F:Longint;
begin
 rez:=TiEle.Create;
 for f:=1 to Kol do  // Если элемнт входит в заданые пределы
  if Els[f].Vme(sx1,sy1,sx2,sy2) then REz.Add(Els[f].Cop);// ТО добавить копию элемента в список
 Sel:=REz;
end;
Procedure TiEle.Cle;// Процедура очистки элмента ;
var
   f:LongInt;
   LKol:Longint;
begin
   lKol:=Kol;
   Kol:=0;
   for f:=1 to lKOl do
   begin
     //els[f].Cle;
     Els[f].Free;
   end;
end;
Procedure TiEle.Sdvig(iMinX,iMinY:Longint);// Сдвигает изображение к краю согластно самой левой координате
var
   f:Longint;
begin

   // Сдвигаем элемент на IMinX Влево и на iMinY ВВерх
   X:=X-IminX;
   Y:=Y-IminY;
   MaxX:=MAxX-IminX;
   MAxY:=MAXY-IminY;

   MinX:=MinX-IminX;
   MinY:=MinY-IminY;
   // Делаем тоже самое со всеми вложеными элементамии
   for f:=1 to kol do
   Els[f].Sdvig(iMinX,IMinY);
end;

{%Endregion}
{%Region /fold} // Инструментарий ===========================================
Function  ObrCol(C:LongWord):LongWord;    // Обрабатывает информацию о Цвете
var
r:LongWord;
b:Array[1..4] of byte absolute r;
begin
r:=c;
b[1]:=Trunc(b[1]/16);
b[2]:=Trunc(b[2]/16);
b[3]:=Trunc(b[3]/16);
b[4]:=Trunc(b[4]/16);
ObrCol:=r;
end;
Function  SRAV(iC1,iC2:LongWord):Boolean; // Сравнивает зва цвета если равны возвращает TRUE
begin
if ObrCol(iC1)=ObrCol(iC2) Then SRAV:=True else SRAV:=False;
end;
Function  TiReadEle(iPOL:TPole;iCoo:TiCoo):TiEle;// Читает элемент с экрана по заданым Коо
var
  Col:LongWord;   // Времннгая переменая для хранения цвета читаемого элемента
  Rez:TiEle;      // Результат возвращаемый элемент структура содержащая список точек
  KolObr:LongWord;// Количесвто обработаных точек
  F,N:Longint;    // Для цикла переменные
  NCOO:TiCoo;     // переменная для временого хранения координат
  Ele:TiEle;      // Переменная для временого хранения созданых элементов из пикселя
begin
Rez:=Nil;// По умолчанию волзвращет NIL то есть сканирование по заданым координатам не удалося так как там уже оформлен какой то другой элементо
if iPol.ReEle(iCoo)=Nil Then // если пиксель по заданым координатам не принадлежит никакому элементу
begin
 Rez:=TiEle.Create;// Создаети элемент
 Rez.Add(iCoo,iPol.RePix(iCoo));// Создает первй элемент из котрого состояит элемент
 IPol.WrEle(iCOO,Rez);                // Указывает то какому элменту принадлежит пиксель
 KolObr:=1;  // Количество обработаных элементов
 While KolObr<>Rez.kol+1 do  // До тех пор пока не обработаны все элементы котрые добавляються по 8 напрвлениям сканирования
 begin
    //if (rez.kol<9) or (trunc(rez.Hiri/9)=(rez.Viso/9)) Then
    //if rez.kol<=7 Then
    if IPol.Krai(Rez.Els[KolObr].Coo) then // ПРоверяет что бы сканируемый пиксель не находился на карю изображения и не выходил за кго пределы
    FOR N:=1  To 8 DO   // Сравниваем по 8 направлениям схожие по цвету пиксели и если совпадают то добавляем в списко
    begin
    NCOO:=Rez.Els[KolObr].COO(N);// Создание координаты  в заданом напрвлении из поля
         if  (iPOL.ReEle(NCOO)=Nil) and  SRAV(iPOL.RePix(NCOO),Rez.Els[KolObr].C) // ПРоевряет не принадлежит ли пиксель в задном напрвлении какому либо элемнту и похож ли он по цвету на сканируемый элемнт
         THEN
         Begin
         Ele:=Rez.Add(NCOO,iPOL.RePix(NCOO)); // Создает из пикселя элемент и добавляет в списко элементов
         IPol.WrEle(NCOO,Ele);                // Указывает то какому элменту принадлежит пиксель
         end;
    end;
 KolObr:=KolObr+1;// Увеличивает количество обработаных элемнтов
 end;
 end;
TiReadEle:=Rez;// Ыозврвщает результат в случае не удачи возвращает NIL
end;
Function  TiReadEls(iPOL:TPole):TiEle;           // просот создает список элементов сканируя построчно
var
  x,y:Longint;
  REz:TiEle;
  Ele:TiEle;
begin
rez:=TiEle.Create;
     // подготавливаем поле для разбивки изображения на элменты
     for y:=0 to IPOL.info.bmiHeader.biHeight-1 do
     for x:=0 to IPOL.info.bmiHeader.biWidth-1 do
     iPol.WrEle(x,y,nil);

     // Чтиаем элемнты изображения
     for y:=0 to IPOL.info.bmiHeader.biHeight-1 do
     for x:=0 to IPOL.info.bmiHeader.biWidth-1 do
     If rez.Kol<TiMaxKolEls then
     begin
     Ele:=TiReadEle(iPol,Coo(x,y));
     if ele<>nil then rez.Add(ele);
     end;
TiReadEls:=rez;
end;


Procedure TiReadOkr(iPOL:TPole;iEle:TiEle);// Заполняет поле Okr Окружения
var
  E,P,N:Longint;
  Se:Pointer;
begin
  for E:=1 to iEle.Kol do        // Номер Элемента
  for P:=1 to iEle.Els[E].Kol do // Номер Пикселя
  For N:=1 to 8 do               // Номер направления
  begin
  Se:=iPol.ReEle(iEle.Els[E].Els[P].COO(N));
  if TiEle(Se)<>(iEle.Els[E]) then
  iEle.Els[E].Okr.Add(TiEle(Se));
  end;
end;


Procedure DrawEls(iPol:TPole;iEle:TiEle); // Функция рисования элемента на поле
var
F:Longint;
Begin
 IPol.WrPix(iEle.X,iEle.Y,iEle.C);// Рисует пиксель на канве
 IPol.WrEle(iEle.X,iEle.Y,Addr(iEle));// Указывает адрес элемента котрому принадлежит пиксель
 For f:=1 to iEle.KOl do // РИсуент вложеные елеметы если они есть
 DrawEls(iPol,iEle.Els[f]);
end;

Procedure DrawElsV(iPol:TPole;iEle:TiEle;iC:LongWord); // Функция рисования элемента на поле заданым цветом
var
F:Longint;
uC:LongWord;
Begin
 IPol.WrPix(iEle.X,iEle.Y,iC);// Рисует пиксель на канве
 IPol.WrEle(iEle.X,iEle.Y,Addr(iEle));// Указывает адрес элемента котрому принадлежит пиксель
 uC:=Random(16000000);
 For f:=1 to iEle.KOl do // РИсуент вложеные елеметы если они есть
 DrawElsV(iPol,iEle.Els[f],uC);
end;

{%Endregion}
Const //  Константы
  MAshtab=4;
var   // Переменные
mb:Boolean;     // Если правда занчит нажата кнопка мышкИ
mx,mY:Longint;  // координаты Где была нажата мышка
Rx,RY:Longint;  // координаты сканируемого участка экрана
pole1:TPole;    // Матрица для ввода изображения
pole2:TPole;    // Матрица для вывода изображения
pole3:TPole;    // Матрица для Выделеного изображения
SMB:Boolean;    // Если правда идет выделение участка изображения
SX1,SY1:Longint;// НАчало выделения
SX2,SY2:Longint;// Окончание выделения
AddEle:Boolean; //
procedure TFGLAZ.Timer1Timer(Sender: TObject); // Цикл  обработки изображения
Var  // переменные
Els:TiEle;// Список всех элементов на экране
Sel:TiEle;// Список Выделеных эементов на экране
begin
{%Region /fold} // Создание полей изображения
if Pole2=Nil then Pole2:=TPOle.Create(Image2.Width,Image2.Height,MAshtab);// ПОле с оригинальным изображением
if Pole1=Nil then Pole1:=TPOle.Create(Image2.Width,Image2.Height,MAshtab);// Поле вывода изображения
if Pole3=Nil then Pole3:=TPOle.Create(Image2.Width,Image2.Height,MAshtab);// Поле вывода Выделеного изображения
{%EndRegion}
{%Region /fold} // Коорекция изображений размеров если изменилися их рамеры

// Коррекция оригинального ихзображения
pole2.SetSize(Image2.Width,Image2.Height,MAshtab);
Image2.Picture.Bitmap.Height:=Image2.Height;
Image2.Picture.Bitmap.Width:=Image2.Width;
// Корекция выводимого изображения
pole1.SetSize(Image2.Width,Image2.Height,MAshtab);
Image1.Picture.Bitmap.Height:=Image1.Height;
Image1.Picture.Bitmap.Width:=Image1.Width;
// Корекция внуктрение представление выводимого изображения
Image4.Picture.Bitmap.Height:=Image4.Height;
Image4.Picture.Bitmap.Width:=Image4.Width;
// Корекция Выделеного  выводимого изображения
pole3.SetSize(Image2.Width,Image2.Height,MAshtab);
Image3.Picture.Bitmap.Height:=Image3.Height;
Image3.Picture.Bitmap.Width:=Image3.Width;

{%EndRegion}

Pole2.ReEcr(RX,RY);// Чтение изображения с экрана
Pole2.WrCan(Image2.Canvas);// Рисование прочитаного с экрана изображения
Els:=TiReadEls(Pole2); // Разбиваем на элементы изображние

Sel:=Els.Sel(sx1,sy1,sx2,sy2);// ПОлучаем списко выделеных элементов
Sel.SDVIG(Sel.Minx,Sel.MinY);// Сдвигает все элементы к краю

if AddEle then
          begin
          ListBox1.AddItem(Edit1.Text,Sel.Cop);
          AddEle:=False;
          end;

Pole3.Clear;// Очиска поля для вывода изображения
pole3.SetSize(Sel.MaxX+2,Sel.MaxY+2,1);
DrawEls(Pole3,Sel);// РИсуем выделеные элементы изображение
Pole3.WrCan(Image3.Canvas);// Выводим выделеное  изображение из матрицы на канву

Label1.Caption:='Кол Элементов '+IntToStr(Els.Kol)+' '+inttostr(sel.Kol);
Label2.Caption:='Кол Пикселей '+IntToStr(POle2.info.bmiHeader.biWidth*POle2.info.bmiHeader.biHeight);


Pole1.Clear;// Очиска поля для вывода изображения
DrawEls(Pole1,els);// РИсуем из элементов изображение
Pole1.Rect(SX1,SY1,SX2,SY2,ClYellow);// рисуем рамку выделения
Pole1.WrCan(Image1.Canvas);// Выводим  изображение из матрицы на канву

Pole1.Clear;// Очиска поля для вывода изображения
DrawElsV(Pole1,els,ClWhite);// РИсуем из элементов изображение
Pole1.WrCan(Image4.Canvas);// Выводим  изображение из матрицы на канву


{%Region /fold}// Особождение всех элементов
//Sel.Cle;
Sel.Free;
//Els.Cle;
Els.free;
{%Endregion}
end;
{%Region /fold} // Функции для формы ========================================
procedure TFGLAZ.Button1Click(Sender: TObject);
begin
// Добавить образец изображения
AddEle:=True;
end;

procedure TFGLAZ.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SMB:=True;// Кнопкамышки тока нажата  начало выделенния
  SX1:=Trunc(X/MAshtab);
  SY1:=Trunc(((Image2.Height/Image1.Height) *(Image1.Height-Y))/MAshtab);
end;
procedure TFGLAZ.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if SMB then
   begin
   SX2:=Trunc(X/MAshtab);
   SY2:=Trunc(((Image2.Height/Image1.Height) *(Image1.Height-Y))/MAshtab);
   end;
end;
procedure TFGLAZ.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    SMB:=False;// Кнопка поднимаеться на мушке выделение завершено
end;


procedure TFGLAZ.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mb:=true; // Указываем что была нажата мышка
  mx:=x   ; // Запоминаем координаты где была нажата мышка
  my:=y   ;
end;
procedure TFGLAZ.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if mb then
  begin
  rx:=rx+(mx-x);
  ry:=ry+(my-y);

  // ПРоверка выхода координат за пределы экрана
  if rx<0 Then Rx:=0;
  if ry<0 Then RY:=0;

  if rx+trunc(Image2.width/Mashtab) >Screen.Width  then rx:=Screen.Width -trunc(Image2.Width/MAshtab);
  if ry+trunc(Image2.height/Mashtab)>Screen.Height then ry:=Screen.Height-trunc(Image2.height/MAshtab);

  mx:=x;
  my:=y;
end;
end;
procedure TFGLAZ.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mb:=false;
end;

procedure TFGLAZ.MenuItem1Click(Sender: TObject);
begin

end;

{%Endregion}

end.