Last active
August 29, 2015 14:27
-
-
Save MisterTimur/2551507245f3453d03cd to your computer and use it in GitHub Desktop.
uglaz.pas
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment